Theory AuxLemmas

section ‹Auxiliary lemmas›

theory AuxLemmas imports Main begin

abbreviation "arbitrary == undefined"

text ‹Lemmas about left- and rightmost elements in lists›

lemma leftmost_element_property:
  assumes "x  set xs. P x"
  obtains zs x' ys where "xs = zs@x'#ys" and "P x'" and "z  set zs. ¬ P z"
proof(atomize_elim)
  from x  set xs. P x 
  show "zs x' ys. xs = zs @ x' # ys  P x'  (zset zs. ¬ P z)"
  proof(induct xs)
    case Nil thus ?case by simp
  next
    case (Cons x' xs')
    note IH = aset xs'. P a
       zs x' ys. xs' = zs@x'#ys  P x'  (zset zs. ¬ P z)
    show ?case
    proof (cases "P x'")
      case True
      then have "(ys. x' # xs' = [] @ x' # ys)  P x'  (xset []. ¬ P x)" by simp
      then show ?thesis by blast
    next
      case False
      with yset (x'#xs'). P y have "yset xs'. P y" by simp
      from IH[OF this] obtain y ys zs where "xs' = zs@y#ys"
        and "P y" and "zset zs. ¬ P z" by blast
      from zset zs. ¬ P z False have "zset (x'#zs). ¬ P z" by simp
      with xs' = zs@y#ys P y show ?thesis by (metis Cons_eq_append_conv)
    qed
  qed
qed



lemma rightmost_element_property:
  assumes "x  set xs. P x"
  obtains ys x' zs where "xs = ys@x'#zs" and "P x'" and "z  set zs. ¬ P z"
proof(atomize_elim)
  from x  set xs. P x
  show "ys x' zs. xs = ys @ x' # zs  P x'  (zset zs. ¬ P z)"
  proof(induct xs)
    case Nil thus ?case by simp
  next
    case (Cons x' xs')
    note IH = aset xs'. P a
       ys x' zs. xs' = ys @ x' # zs  P x'  (zset zs. ¬ P z)
    show ?case
    proof(cases "yset xs'. P y")
      case True
      from IH[OF this] obtain y ys zs where "xs' = ys @ y # zs"
        and "P y" and "zset zs. ¬ P z" by blast
      thus ?thesis by (metis Cons_eq_append_conv)
    next
      case False
      with yset (x'#xs'). P y have "P x'" by simp
      with False show ?thesis by (metis eq_Nil_appendI)
    qed
  qed
qed


text ‹Lemma concerning maps and @›

lemma map_append_append_maps:
  assumes map:"map f xs = ys@zs"
  obtains xs' xs'' where "map f xs' = ys" and "map f xs'' = zs" and "xs=xs'@xs''"
by (metis append_eq_conv_conj append_take_drop_id assms drop_map take_map that)


text ‹Lemma concerning splitting of @{term list}s›

lemma  path_split_general:
assumes all:"zs. xs  ys@zs"
obtains j zs where "xs = (take j ys)@zs" and "j < length ys"
  and "k > j. zs'. xs  (take k ys)@zs'"
proof(atomize_elim)
  from zs. xs  ys@zs
  show "j zs. xs = take j ys @ zs  j < length ys  
               (k>j. zs'. xs  take k ys @ zs')"
  proof(induct ys arbitrary:xs)
    case Nil thus ?case by auto
  next
    case (Cons y' ys')
    note IH = xs. zs. xs  ys' @ zs 
      j zs. xs = take j ys' @ zs  j < length ys'  
      (k. j < k  (zs'. xs  take k ys' @ zs'))
    show ?case
    proof(cases xs)
      case Nil thus ?thesis by simp
    next
      case (Cons x' xs')
      with zs. xs  (y' # ys') @ zs have "x'  y'  (zs. xs'  ys' @ zs)"
        by simp
      show ?thesis
      proof(cases "x' = y'")
        case True
        with x'  y'  (zs. xs'  ys' @ zs) have "zs. xs'  ys' @ zs" by simp
        from IH[OF this] have "j zs. xs' = take j ys' @ zs  j < length ys' 
          (k. j < k  (zs'. xs'  take k ys' @ zs'))" .
        then obtain j zs where "xs' = take j ys' @ zs"
          and "j < length ys'"
          and all_sub:"k. j < k  (zs'. xs'  take k ys' @ zs')"
          by blast
        from xs' = take j ys' @ zs True
          have "(x'#xs') = take (Suc j) (y' # ys') @ zs"
          by simp
        from all_sub True have all_imp:"k. j < k  
          (zs'. (x'#xs')  take (Suc k) (y' # ys') @ zs')"
          by auto
        { fix l assume "(Suc j) < l"
          then obtain k where [simp]:"l = Suc k" by(cases l) auto
          with (Suc j) < l have "j < k" by simp
          with all_imp 
          have "zs'. (x'#xs')  take (Suc k) (y' # ys') @ zs'"
            by simp
          hence "zs'. (x'#xs')  take l (y' # ys') @ zs'"
            by simp }
        with (x'#xs') = take (Suc j) (y' # ys') @ zs j < length ys' Cons
        show ?thesis by (metis Suc_length_conv less_Suc_eq_0_disj)
      next
        case False
        with Cons have "i zs'. i > 0  xs  take i (y' # ys') @ zs'"
          by auto(case_tac i,auto)
        moreover
        have "zs. xs = take 0 (y' # ys') @ zs" by simp
        ultimately show ?thesis by(rule_tac x="0" in exI,auto)
      qed
    qed
  qed
qed

end

Theory BasicDefs

chapter ‹The Framework›

theory BasicDefs imports AuxLemmas begin

text ‹
  As slicing is a program analysis that can be completely based on the
  information given in the CFG, we want to provide a framework which
  allows us to formalize and prove properties of slicing regardless of
  the actual programming language. So the starting point for the formalization 
  is the definition of an abstract CFG, i.e.\ without considering features 
  specific for certain languages. By doing so we ensure that our framework 
  is as generic as possible since all proofs hold for every language whose 
  CFG conforms to this abstract CFG.  This abstract CFG can be used as a 
  basis for static intraprocedural slicing as well as for dynamic slicing, 
  if in the dynamic case all method calls are inlined (i.e., abstract CFG 
  paths conform to traces).
›

section ‹Basic Definitions›

subsection‹Edge kinds›

datatype 'state edge_kind = Update "'state  'state"           ("_")
                          | Predicate "'state  bool"      ("'(_')")


subsection ‹Transfer and predicate functions›

fun transfer :: "'state edge_kind  'state  'state"
where "transfer (f) s = f s"
  | "transfer (P) s   = s"

fun transfers :: "'state edge_kind list  'state  'state"
where "transfers [] s   = s"
  | "transfers (e#es) s = transfers es (transfer e s)"

fun pred :: "'state edge_kind  'state  bool"
where "pred (f) s = True"
  | "pred (P) s   = (P s)"

fun preds :: "'state edge_kind list  'state  bool"
where "preds [] s   = True"
  | "preds (e#es) s = (pred e s  preds es (transfer e s))"



lemma transfers_split:
  "(transfers (ets@ets') s) = (transfers ets' (transfers ets s))"
by(induct ets arbitrary:s) auto

lemma preds_split:
  "(preds (ets@ets') s) = (preds ets s  preds ets' (transfers ets s))"
by(induct ets arbitrary:s) auto


lemma transfers_id_no_influence:
  "transfers [et  ets. et  id] s = transfers ets s"
by(induct ets arbitrary:s,auto)

lemma preds_True_no_influence:
  "preds [et  ets. et  (λs. True)] s = preds ets s"
by(induct ets arbitrary:s,auto)

end

Theory CFG

section ‹CFG›

theory CFG imports BasicDefs begin

subsection ‹The abstract CFG›

locale CFG =
  fixes sourcenode :: "'edge  'node"
  fixes targetnode :: "'edge  'node"
  fixes kind :: "'edge  'state edge_kind"
  fixes valid_edge :: "'edge  bool"
  fixes Entry::"'node" ("'('_Entry'_')")
  assumes Entry_target [dest]: "valid_edge a; targetnode a = (_Entry_)  False"
  and edge_det: 
  "valid_edge a; valid_edge a'; sourcenode a = sourcenode a'; 
    targetnode a = targetnode a'  a = a'"

begin

definition valid_node :: "'node  bool"
  where "valid_node n  
  (a. valid_edge a  (n = sourcenode a  n = targetnode a))"

lemma [simp]: "valid_edge a  valid_node (sourcenode a)"
  by(fastforce simp:valid_node_def)

lemma [simp]: "valid_edge a  valid_node (targetnode a)"
  by(fastforce simp:valid_node_def)


subsection ‹CFG paths and lemmas›

inductive path :: "'node  'edge list  'node  bool"
  ("_ -_→* _" [51,0,0] 80)
where 
  empty_path:"valid_node n  n -[]→* n"

  | Cons_path:
  "n'' -as→* n'; valid_edge a; sourcenode a = n; targetnode a = n''
     n -a#as→* n'"


lemma path_valid_node:
  assumes "n -as→* n'" shows "valid_node n" and "valid_node n'"
  using n -as→* n'
  by(induct rule:path.induct,auto)

lemma empty_path_nodes [dest]:"n -[]→* n'  n = n'"
  by(fastforce elim:path.cases)

lemma path_valid_edges:"n -as→* n'  a  set as. valid_edge a"
by(induct rule:path.induct) auto


lemma path_edge:"valid_edge a  sourcenode a -[a]→* targetnode a"
  by(fastforce intro:Cons_path empty_path)


lemma path_Entry_target [dest]:
  assumes "n -as→* (_Entry_)"
  shows "n = (_Entry_)" and "as = []"
using n -as→* (_Entry_)
proof(induct n as n'"(_Entry_)" rule:path.induct)
  case (Cons_path n'' as a n)
  from targetnode a = n'' valid_edge a n'' = (_Entry_) have False
    by -(rule Entry_target,simp_all)
  { case 1
    with ‹False› show ?case ..
  next
    case 2
    with ‹False› show ?case ..
  }
qed simp_all



lemma path_Append:"n -as→* n''; n'' -as'→* n' 
   n -as@as'→* n'"
by(induct rule:path.induct,auto intro:Cons_path)


lemma path_split:
  assumes "n -as@a#as'→* n'"
  shows "n -as→* sourcenode a" and "valid_edge a" and "targetnode a -as'→* n'"
  using n -as@a#as'→* n'
proof(induct as arbitrary:n)
  case Nil case 1
  thus ?case by(fastforce elim:path.cases intro:empty_path)
next
  case Nil case 2
  thus ?case by(fastforce elim:path.cases intro:path_edge)
next
  case Nil case 3
  thus ?case by(fastforce elim:path.cases)
next
  case (Cons ax asx) 
  note IH1 = n. n -asx@a#as'→* n'  n -asx→* sourcenode a
  note IH2 = n. n -asx@a#as'→* n'  valid_edge a
  note IH3 = n. n -asx@a#as'→* n'  targetnode a -as'→* n'
  { case 1 
    hence "sourcenode ax = n" and "targetnode ax -asx@a#as'→* n'" and "valid_edge ax"
      by(auto elim:path.cases)
    from IH1[OF targetnode ax -asx@a#as'→* n'] 
    have "targetnode ax -asx→* sourcenode a" .
    with sourcenode ax = n valid_edge ax show ?case by(fastforce intro:Cons_path)
  next
    case 2 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
    from IH2[OF this] show ?case .
  next
    case 3 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
    from IH3[OF this] show ?case .
  }
qed


lemma path_split_Cons:
  assumes "n -as→* n'" and "as  []"
  obtains a' as' where "as = a'#as'" and "n = sourcenode a'"
  and "valid_edge a'" and "targetnode a' -as'→* n'"
proof -
  from as  [] obtain a' as' where "as = a'#as'" by(cases as) auto
  with n -as→* n' have "n -[]@a'#as'→* n'" by simp
  hence "n -[]→* sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
    by(rule path_split)+
  from n -[]→* sourcenode a' have "n = sourcenode a'" by fast
  with as = a'#as' valid_edge a' targetnode a' -as'→* n' that show ?thesis 
    by fastforce
qed


lemma path_split_snoc:
  assumes "n -as→* n'" and "as  []"
  obtains a' as' where "as = as'@[a']" and "n -as'→* sourcenode a'"
  and "valid_edge a'" and "n' = targetnode a'"
proof -
  from as  [] obtain a' as' where "as = as'@[a']" by(cases as rule:rev_cases) auto
  with n -as→* n' have "n -as'@a'#[]→* n'" by simp
  hence "n -as'→* sourcenode a'" and "valid_edge a'" and "targetnode a' -[]→* n'"
    by(rule path_split)+
  from targetnode a' -[]→* n' have "n' = targetnode a'" by fast
  with as = as'@[a'] valid_edge a' n -as'→* sourcenode a' that show ?thesis 
    by fastforce
qed


lemma path_split_second:
  assumes "n -as@a#as'→* n'" shows "sourcenode a -a#as'→* n'"
proof -
  from n -as@a#as'→* n' have "valid_edge a" and "targetnode a -as'→* n'"
    by(auto intro:path_split)
  thus ?thesis by(fastforce intro:Cons_path)
qed


lemma path_Entry_Cons:
  assumes "(_Entry_) -as→* n'" and "n'  (_Entry_)"
  obtains n a where "sourcenode a = (_Entry_)" and "targetnode a = n"
  and "n -tl as→* n'" and "valid_edge a" and "a = hd as"
proof -
  from (_Entry_) -as→* n' n'  (_Entry_) have "as  []"
    by(cases as,auto elim:path.cases)
  with (_Entry_) -as→* n' obtain a' as' where "as = a'#as'" 
    and "(_Entry_) = sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
    by(erule path_split_Cons)
  with that show ?thesis by fastforce
qed


lemma path_det:
  "n -as→* n'; n -as→* n''  n' = n''"
proof(induct as arbitrary:n)
  case Nil thus ?case by(auto elim:path.cases)
next
  case (Cons a' as')
  note IH = n. n -as'→* n'; n -as'→* n''  n' = n''
  from n -a'#as'→* n' have "targetnode a' -as'→* n'" 
    by(fastforce elim:path_split_Cons)
  from n -a'#as'→* n'' have "targetnode a' -as'→* n''" 
    by(fastforce elim:path_split_Cons)
  from IH[OF targetnode a' -as'→* n' this] show ?thesis .
qed


definition
  sourcenodes :: "'edge list  'node list"
  where "sourcenodes xs  map sourcenode xs"

definition
  kinds :: "'edge list  'state edge_kind list"
  where "kinds xs  map kind xs"

definition
  targetnodes :: "'edge list  'node list"
  where "targetnodes xs  map targetnode xs"


lemma path_sourcenode:
  "n -as→* n'; as  []  hd (sourcenodes as) = n"
by(fastforce elim:path_split_Cons simp:sourcenodes_def)



lemma path_targetnode:
  "n -as→* n'; as  []  last (targetnodes as) = n'"
by(fastforce elim:path_split_snoc simp:targetnodes_def)



lemma sourcenodes_is_n_Cons_butlast_targetnodes:
  "n -as→* n'; as  []  
  sourcenodes as = n#(butlast (targetnodes as))"
proof(induct as arbitrary:n)
  case Nil thus ?case by simp
next
  case (Cons a' as')
  note IH = n. n -as'→* n'; as'  []
             sourcenodes as' = n#(butlast (targetnodes as'))
  from n -a'#as'→* n' have "n = sourcenode a'" and "targetnode a' -as'→* n'"
    by(auto elim:path_split_Cons)
  show ?case
  proof(cases "as' = []")
    case True
    with targetnode a' -as'→* n' have "targetnode a' = n'" by fast
    with True n = sourcenode a' show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  next
    case False
    from IH[OF targetnode a' -as'→* n' this] 
    have "sourcenodes as' = targetnode a' # butlast (targetnodes as')" .
    with n = sourcenode a' False show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  qed
qed



lemma targetnodes_is_tl_sourcenodes_App_n':
  "n -as→* n'; as  []  
    targetnodes as = (tl (sourcenodes as))@[n']"
proof(induct as arbitrary:n' rule:rev_induct)
  case Nil thus ?case by simp
next
  case (snoc a' as')
  note IH = n'. n -as'→* n'; as'  []
     targetnodes as' = tl (sourcenodes as') @ [n']
  from n -as'@[a']→* n' have "n -as'→* sourcenode a'" and "n' = targetnode a'"
    by(auto elim:path_split_snoc)
  show ?case
  proof(cases "as' = []")
    case True
    with n -as'→* sourcenode a' have "n = sourcenode a'" by fast
    with True n' = targetnode a' show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  next
    case False
    from IH[OF n -as'→* sourcenode a' this]
    have "targetnodes as' = tl (sourcenodes as')@[sourcenode a']" .
    with n' = targetnode a' False show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  qed
qed

lemma Entry_sourcenode_hd:
  assumes "n -as→* n'" and "(_Entry_)  set (sourcenodes as)"
  shows "n = (_Entry_)" and "(_Entry_)  set (sourcenodes (tl as))"
  using n -as→* n' (_Entry_)  set (sourcenodes as)
proof(induct rule:path.induct)
  case (empty_path n) case 1
  thus ?case by(simp add:sourcenodes_def)
next
  case (empty_path n) case 2
  thus ?case by(simp add:sourcenodes_def)
next
  case (Cons_path n'' as n' a n)
  note IH1 = (_Entry_)  set(sourcenodes as)  n'' = (_Entry_)
  note IH2 = (_Entry_)  set(sourcenodes as)  (_Entry_)  set(sourcenodes(tl as))
  have "(_Entry_)  set (sourcenodes(tl(a#as)))"
  proof
    assume "(_Entry_)  set (sourcenodes (tl (a#as)))"
    hence "(_Entry_)  set (sourcenodes as)" by simp
    from IH1[OF this] have "n'' = (_Entry_)" by simp
    with targetnode a = n'' valid_edge a show False by -(erule Entry_target,simp)
  qed
  hence "(_Entry_)  set (sourcenodes(tl(a#as)))" by fastforce
  { case 1
    with (_Entry_)  set (sourcenodes(tl(a#as))) sourcenode a = n
    show ?case by(simp add:sourcenodes_def)
  next
    case 2
    with (_Entry_)  set (sourcenodes(tl(a#as))) sourcenode a = n
    show ?case by(simp add:sourcenodes_def)
  }
qed

end

end

Theory CFGExit

theory CFGExit imports CFG begin

subsection ‹Adds an exit node to the abstract CFG›

locale CFGExit = CFG sourcenode targetnode kind valid_edge Entry
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") + 
  fixes Exit::"'node"  ("'('_Exit'_')")
  assumes Exit_source [dest]: "valid_edge a; sourcenode a = (_Exit_)  False"
  and Entry_Exit_edge: "a. valid_edge a  sourcenode a = (_Entry_) 
    targetnode a = (_Exit_)  kind a = (λs. False)"
  
begin

lemma Entry_noteq_Exit [dest]:
  assumes eq:"(_Entry_) = (_Exit_)" shows "False"
proof -
  from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)" 
    and "valid_edge a" by blast
  with eq show False by simp(erule Exit_source)
qed

lemma Exit_noteq_Entry [dest]:"(_Exit_) = (_Entry_)  False"
  by(rule Entry_noteq_Exit[OF sym],simp)


lemma [simp]: "valid_node (_Entry_)"
proof -
  from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)" 
    and "valid_edge a" by blast
  thus ?thesis by(fastforce simp:valid_node_def)
qed

lemma [simp]: "valid_node (_Exit_)"
proof -
  from Entry_Exit_edge obtain a where "targetnode a = (_Exit_)"
    and "valid_edge a" by blast
  thus ?thesis by(fastforce simp:valid_node_def)
qed


definition inner_node :: "'node  bool"
  where inner_node_def: 
  "inner_node n  valid_node n  n  (_Entry_)  n  (_Exit_)"


lemma inner_is_valid:
  "inner_node n  valid_node n"
by(simp add:inner_node_def valid_node_def)

lemma [dest]:
  "inner_node (_Entry_)  False"
by(simp add:inner_node_def)

lemma [dest]:
  "inner_node (_Exit_)  False" 
by(simp add:inner_node_def)

lemma [simp]:"valid_edge a; targetnode a  (_Exit_) 
   inner_node (targetnode a)"
  by(simp add:inner_node_def,rule ccontr,simp,erule Entry_target)

lemma [simp]:"valid_edge a; sourcenode a  (_Entry_)
   inner_node (sourcenode a)"
  by(simp add:inner_node_def,rule ccontr,simp,erule Exit_source)

lemma valid_node_cases [consumes 1, case_names "Entry" "Exit" "inner"]:
  "valid_node n; n = (_Entry_)  Q; n = (_Exit_)  Q;
    inner_node n  Q  Q"
apply(auto simp:valid_node_def)
 apply(case_tac "sourcenode a = (_Entry_)") apply auto
apply(case_tac "targetnode a = (_Exit_)") apply auto
done

lemma path_Exit_source [dest]:
  assumes "(_Exit_) -as→* n'" shows "n' = (_Exit_)" and "as = []"
  using (_Exit_) -as→* n'
proof(induct n"(_Exit_)" as n' rule:path.induct)
  case (Cons_path n'' as n' a)
  from sourcenode a = (_Exit_) valid_edge a have False 
    by -(rule Exit_source,simp_all)
  { case 1 with ‹False› show ?case ..
  next
    case 2 with ‹False› show ?case ..
  }
qed simp_all

lemma Exit_no_sourcenode[dest]:
  assumes isin:"(_Exit_)  set (sourcenodes as)" and path:"n -as→* n'"
  shows False
proof -
  from isin obtain ns' ns'' where "sourcenodes as = ns'@(_Exit_)#ns''"
    by(auto dest:split_list simp:sourcenodes_def)
  then obtain as' as'' a where "as = as'@a#as''"
    and source:"sourcenode a = (_Exit_)"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  with path have "valid_edge a" by(fastforce dest:path_split)
  with source show ?thesis by -(erule Exit_source)
qed


end 

end

Theory Postdomination

section ‹Postdomination›

theory Postdomination imports CFGExit begin

subsection ‹Standard Postdomination›

locale Postdomination = CFGExit sourcenode targetnode kind valid_edge Entry Exit 
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Exit :: "'node" ("'('_Exit'_')") +
  assumes Entry_path:"valid_node n  as. (_Entry_) -as→* n"
  and Exit_path:"valid_node n  as. n -as→* (_Exit_)"

begin

definition postdominate :: "'node  'node  bool" ("_ postdominates _" [51,0])
where postdominate_def:"n' postdominates n  
    (valid_node n  valid_node n' 
    ((as. n -as→* (_Exit_)  n'  set (sourcenodes as))))"


lemma postdominate_implies_path: 
  assumes "n' postdominates n" obtains as where "n -as→* n'"
proof(atomize_elim)
  from n' postdominates n have "valid_node n"
    and all:"as. n -as→* (_Exit_)  n'  set(sourcenodes as)"
    by(auto simp:postdominate_def)
  from ‹valid_node n obtain as where "n -as→* (_Exit_)" by(auto dest:Exit_path)
  with all have "n'  set(sourcenodes as)" by simp
  then obtain ns ns' where "sourcenodes as = ns@n'#ns'" by(auto dest:split_list)
  then obtain as' a as'' where "sourcenodes as' = ns" 
    and "sourcenode a = n'" and "as = as'@a#as''"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  from n -as→* (_Exit_) as = as'@a#as'' have "n -as'→* sourcenode a"
    by(fastforce dest:path_split)
  with sourcenode a = n' show "as. n -as→* n'" by blast
qed



lemma postdominate_refl:
  assumes valid:"valid_node n" and notExit:"n  (_Exit_)"
  shows "n postdominates n"
using valid
proof(induct rule:valid_node_cases)
  case Entry
  { fix as assume path:"(_Entry_) -as→* (_Exit_)"
    hence notempty:"as  []" 
      apply - apply(erule path.cases)
      by (drule sym,simp,drule Exit_noteq_Entry,auto)
    with path have "hd (sourcenodes as) = (_Entry_)" 
      by(fastforce intro:path_sourcenode)
    with notempty have "(_Entry_)  set (sourcenodes as)"
      by(fastforce intro:hd_in_set simp:sourcenodes_def) }
  with Entry show ?thesis by(simp add:postdominate_def)
next
  case Exit
  with notExit have False by simp
  thus ?thesis by simp
next
  case inner
  show ?thesis
  proof(cases "as. n -as→* (_Exit_)")
    case True
    { fix as' assume path':"n -as'→* (_Exit_)"
      with inner have notempty:"as'  []"
        by(cases as',auto elim!:path.cases simp:inner_node_def)
      with path' inner have hd:"hd (sourcenodes as') = n"
        by -(rule path_sourcenode)
      from notempty have "sourcenodes as'  []" by(simp add:sourcenodes_def)
      with hd[THEN sym] have "n  set (sourcenodes as')" by simp }
    hence "as. n -as→* (_Exit_)  n  set (sourcenodes as)" by simp
    with True inner show ?thesis by(simp add:postdominate_def inner_is_valid)
  next
    case False
    with inner show ?thesis by(simp add:postdominate_def inner_is_valid)
  qed
qed


lemma postdominate_trans:
  assumes pd1:"n'' postdominates n" and pd2:"n' postdominates n''"
  shows "n' postdominates n"
proof -
  from pd1 pd2 have valid:"valid_node n" and valid':"valid_node n'"
    by(simp_all add:postdominate_def)
  { fix as assume path:"n -as→* (_Exit_)"
    with pd1 have "n''  set (sourcenodes as)" by(simp add:postdominate_def)
    then obtain ns' ns'' where "sourcenodes as = ns'@n''#ns''"
      by(auto dest:split_list)
    then obtain as' as'' a
      where as'':"sourcenodes as'' = ns''" and as:"as=as'@a#as''"
      and source:"sourcenode a = n''"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from as path have "n -as'@a#as''→* (_Exit_)" by simp
    with source have path':"n'' -a#as''→* (_Exit_)"
      by(fastforce dest:path_split_second)
    with pd2 have "n'  set(sourcenodes (a#as''))"
      by(auto simp:postdominate_def)
    with as have "n'  set(sourcenodes as)" by(auto simp:sourcenodes_def) }
  with valid valid' show ?thesis by(simp add:postdominate_def)
qed


lemma postdominate_antisym:
  assumes pd1:"n' postdominates n" and pd2:"n postdominates n'"
  shows "n = n'"
proof -
  from pd1 have valid:"valid_node n" and valid':"valid_node n'" 
    by(auto simp:postdominate_def)
  from valid obtain as where path1:"n -as→* (_Exit_)" by(fastforce dest:Exit_path)
  from valid' obtain as' where path2:"n' -as'→* (_Exit_)" by(fastforce dest:Exit_path)
  from pd1 path1 have "nx  set(sourcenodes as). nx = n'"
    by(simp add:postdominate_def)
  then obtain ns ns' where sources:"sourcenodes as = ns@n'#ns'"
    and all:"nx  set ns'. nx  n'"
    by(fastforce elim!: rightmost_element_property)
  from sources obtain asx a asx' where ns':"ns' = sourcenodes asx'"
    and as:"as = asx@a#asx'" and source:"sourcenode a = n'"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  from path1 as have "n -asx@a#asx'→* (_Exit_)" by simp
  with source have "n' -a#asx'→* (_Exit_)" by(fastforce dest:path_split_second)
  with pd2 have "n  set(sourcenodes (a#asx'))" by(simp add:postdominate_def)
  with source have "n = n'  n  set(sourcenodes asx')" by(simp add:sourcenodes_def)
  thus ?thesis
  proof
    assume "n = n'" thus ?thesis .
  next
    assume "n  set(sourcenodes asx')"
    then obtain nsx' nsx'' where "sourcenodes asx' = nsx'@n#nsx''"
      by(auto dest:split_list)
    then obtain asi asi' a' where asx':"asx' = asi@a'#asi'"
      and source':"sourcenode a' = n"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with path1 as have "n -(asx@a#asi)@a'#asi'→* (_Exit_)" by simp
    with source' have "n -a'#asi'→* (_Exit_)" by(fastforce dest:path_split_second)
    with pd1 have "n'  set(sourcenodes (a'#asi'))" by(auto simp:postdominate_def)
    with source' have "n' = n  n'  set(sourcenodes asi')"
      by(simp add:sourcenodes_def)
    thus ?thesis
    proof
      assume "n' = n" thus ?thesis by(rule sym)
    next
      assume "n'  set(sourcenodes asi')"
      with asx' ns' have "n'  set ns'" by(simp add:sourcenodes_def)
      with all have False by blast
      thus ?thesis by simp
    qed
  qed
qed


lemma postdominate_path_branch:
  assumes "n -as→* n''" and "n' postdominates n''" and "¬ n' postdominates n"  
  obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
  and "¬ n' postdominates (sourcenode a)" and "n' postdominates (targetnode a)"
proof(atomize_elim)
  from assms
  show "as' a as''. as = as'@a#as''  valid_edge a  
    ¬ n' postdominates (sourcenode a)  n' postdominates (targetnode a)"
  proof(induct rule:path.induct)
    case (Cons_path n'' as nx a n)
    note IH = n' postdominates nx; ¬ n' postdominates n''
       as' a as''. as = as'@a#as''  valid_edge a 
        ¬ n' postdominates sourcenode a  n' postdominates targetnode a
    show ?case
    proof(cases "n' postdominates n''")
      case True
      with ¬ n' postdominates n sourcenode a = n targetnode a = n'' 
        valid_edge a
      show ?thesis by blast
    next
      case False
      from IH[OF n' postdominates nx this] show ?thesis
        by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
    qed
  qed simp
qed


lemma Exit_no_postdominator:
  "(_Exit_) postdominates n  False"
by(fastforce dest:Exit_path simp:postdominate_def)


lemma postdominate_path_targetnode:
  assumes "n' postdominates n" and "n -as→* n''" and "n'  set(sourcenodes as)"
  shows "n' postdominates n''"
proof -
  from n' postdominates n have "valid_node n" and "valid_node n'"
    and all:"as''. n -as''→* (_Exit_)  n'  set(sourcenodes as'')"
    by(simp_all add:postdominate_def)
  from n -as→* n'' have "valid_node n''" by(fastforce dest:path_valid_node)
  have "as''. n'' -as''→* (_Exit_)  n'  set(sourcenodes as'')"
  proof(rule ccontr)
    assume "¬ (as''. n'' -as''→* (_Exit_)  n'  set (sourcenodes as''))"
    then obtain as'' where "n'' -as''→* (_Exit_)"
      and "n'  set (sourcenodes as'')" by blast
    from n -as→* n'' n'' -as''→* (_Exit_) have "n -as@as''→* (_Exit_)" 
      by(rule path_Append)
    with n'  set(sourcenodes as) n'  set (sourcenodes as'')
    have "n'  set (sourcenodes (as@as''))"
      by(simp add:sourcenodes_def)
    with n -as@as''→* (_Exit_) n' postdominates n show False
      by(simp add:postdominate_def)
  qed
  with ‹valid_node n' ‹valid_node n'' show ?thesis by(simp add:postdominate_def)
qed


lemma not_postdominate_source_not_postdominate_target:
  assumes "¬ n postdominates (sourcenode a)" and "valid_node n" and "valid_edge a"
  obtains ax where "sourcenode a = sourcenode ax" and "valid_edge ax"
  and "¬ n postdominates targetnode ax"
proof(atomize_elim)
  show "ax. sourcenode a = sourcenode ax  valid_edge ax  
    ¬ n postdominates targetnode ax"
  proof -
    from assms obtain asx 
      where "sourcenode a -asx→* (_Exit_)"
      and "n  set(sourcenodes asx)" by(auto simp:postdominate_def)
    from sourcenode a -asx→* (_Exit_) valid_edge a 
    obtain ax asx' where [simp]:"asx = ax#asx'"
      apply - apply(erule path.cases)
      apply(drule_tac s="(_Exit_)" in sym)
      apply simp
      apply(drule Exit_source)
      by simp_all
    with sourcenode a -asx→* (_Exit_) have "sourcenode a -[]@ax#asx'→* (_Exit_)"
      by simp
    hence "valid_edge ax" and "sourcenode a = sourcenode ax"
      and "targetnode ax -asx'→* (_Exit_)"
      by(fastforce dest:path_split)+
    with n  set(sourcenodes asx) have "¬ n postdominates targetnode ax"
      by(fastforce simp:postdominate_def sourcenodes_def)
    with sourcenode a = sourcenode ax valid_edge ax show ?thesis by blast
  qed
qed


lemma inner_node_Entry_edge:
  assumes "inner_node n" 
  obtains a where "valid_edge a" and "inner_node (targetnode a)"
  and "sourcenode a = (_Entry_)"
proof(atomize_elim)
  from ‹inner_node n have "valid_node n" by(rule inner_is_valid)
  then obtain as where "(_Entry_) -as→* n" by(fastforce dest:Entry_path)
  show "a. valid_edge a  inner_node (targetnode a)  sourcenode a = (_Entry_)"
  proof(cases "as = []")
    case True
    with ‹inner_node n (_Entry_) -as→* n have False 
      by(fastforce simp:inner_node_def)
    thus ?thesis by simp
  next
    case False
    with (_Entry_) -as→* n obtain a' as' where "as = a'#as'"
      and "(_Entry_) = sourcenode a'" and "valid_edge a'" 
      and "targetnode a' -as'→* n" 
      by -(erule path_split_Cons)
    from valid_edge a' have "valid_node (targetnode a')" by simp
    thus ?thesis
    proof(cases "targetnode a'" rule:valid_node_cases)
      case Entry
      from valid_edge a' this have False by(rule Entry_target)
      thus ?thesis by simp
    next
      case Exit
      with targetnode a' -as'→* n ‹inner_node n
      have False by simp (drule path_Exit_source,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case inner
      with valid_edge a' (_Entry_) = sourcenode a' show ?thesis by simp blast
    qed
  qed
qed


lemma inner_node_Exit_edge:
  assumes "inner_node n" 
  obtains a where "valid_edge a" and "inner_node (sourcenode a)"
  and "targetnode a = (_Exit_)"
proof(atomize_elim)
  from ‹inner_node n have "valid_node n" by(rule inner_is_valid)
  then obtain as where "n -as→* (_Exit_)" by(fastforce dest:Exit_path)
  show "a. valid_edge a  inner_node (sourcenode a)  targetnode a = (_Exit_)"
  proof(cases "as = []")
    case True
    with ‹inner_node n n -as→* (_Exit_) have False by fastforce
    thus ?thesis by simp
  next
    case False
    with n -as→* (_Exit_) obtain a' as' where "as = as'@[a']" 
      and "n -as'→* sourcenode a'" and "valid_edge a'" 
      and "(_Exit_) = targetnode a'" by -(erule path_split_snoc)
    from valid_edge a' have "valid_node (sourcenode a')" by simp
    thus ?thesis
    proof(cases "sourcenode a'" rule:valid_node_cases)
      case Entry
      with n -as'→* sourcenode a' ‹inner_node n
      have False by simp (drule path_Entry_target,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case Exit
      from valid_edge a' this have False by(rule Exit_source)
      thus ?thesis by simp
    next
      case inner
      with valid_edge a' (_Exit_) = targetnode a' show ?thesis by simp blast
    qed
  qed
qed




end

subsection ‹Strong Postdomination›


locale StrongPostdomination = 
  Postdomination sourcenode targetnode kind valid_edge Entry Exit 
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Exit :: "'node" ("'('_Exit'_')") +
  assumes successor_set_finite: "valid_node n  
  finite {n'. a'. valid_edge a'  sourcenode a' = n  targetnode a' = n'}"

begin

definition  strong_postdominate :: "'node  'node  bool" 
("_ strongly-postdominates _" [51,0])
where strong_postdominate_def:"n' strongly-postdominates n 
  (n' postdominates n  
  (k  1. as nx. n -as→* nx  
                    length as  k  n'  set(sourcenodes as)))"


lemma strong_postdominate_prop_smaller_path:
  assumes all:"as nx. n -as→* nx  length as  k  n'  set(sourcenodes as)"
  and "n -as→* n''" and "length as  k"
  obtains as' as'' where "n -as'→* n'" and "length as' < k" and "n' -as''→* n''"
  and "as = as'@as''"
proof(atomize_elim)
  show "as' as''. n -as'→* n'  length as' < k  n' -as''→* n''  as = as'@as''"
  proof(rule ccontr)
    assume "¬ (as' as''. n -as'→* n'  length as' < k  n' -as''→* n''  
                          as = as'@as'')"
    hence all':"as' as''. n -as'→* n'  n' -as''→* n''  as = as'@as'' 
       length as'  k" by fastforce
    from all n -as→* n'' ‹length as  k have "nx  set(sourcenodes as). nx = n'"
      by fastforce
    then obtain ns ns' where "sourcenodes as = ns@n'#ns'"
      and "nx  set ns. nx  n'"
      by(fastforce elim!:split_list_first_propE)
    then obtain asx a asx' where [simp]:"ns = sourcenodes asx"
      and [simp]:"as = asx@a#asx'" and "sourcenode a = n'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from n -as→* n'' have "n -asx@a#asx'→* n''" by simp
    with sourcenode a = n' have "n -asx→* n'" and "valid_edge a"
      and "targetnode a -asx'→* n''" by(fastforce dest:path_split)+
    with sourcenode a = n' have "n' -a#asx'→* n''" by(fastforce intro:Cons_path)
    with n -asx→* n' all' have "length asx  k" by simp
    with n -asx→* n' all have "n'  set(sourcenodes asx)" by fastforce
    with nx  set ns. nx  n' show False by fastforce
  qed
qed



lemma strong_postdominate_refl:
  assumes "valid_node n" and "n  (_Exit_)"
  shows "n strongly-postdominates n"
proof -
  from assms have "n postdominates n" by(rule postdominate_refl)
  { fix as nx assume "n -as→* nx" and "length as  1"
    then obtain a' as' where [simp]:"as = a'#as'" by(cases as) auto
    with n -as→* nx have "n -[]@a'#as'→* nx" by simp
    hence "n = sourcenode a'" by(fastforce dest:path_split)
    hence "n  set(sourcenodes as)" by(simp add:sourcenodes_def) }
  hence "as nx. n -as→* nx  length as  1  n  set(sourcenodes as)"
    by auto
  hence "k  1. as nx. n -as→* nx  length as  k  n  set(sourcenodes as)"
    by blast
  with n postdominates n show ?thesis by(simp add:strong_postdominate_def)
qed


lemma strong_postdominate_trans:
  assumes "n'' strongly-postdominates n" and "n' strongly-postdominates n''"
  shows "n' strongly-postdominates n"
proof -
  from n'' strongly-postdominates n have "n'' postdominates n"
    and paths1:"k  1. as nx. n -as→* nx  length as  k 
              n''  set(sourcenodes as)"
    by(auto simp only:strong_postdominate_def)
  from paths1 obtain k1 
    where all1:"as nx. n -as→* nx  length as  k1  n''  set(sourcenodes as)"
    and "k1  1" by blast
  from n' strongly-postdominates n'' have "n' postdominates n''"
    and paths2:"k  1. as nx. n'' -as→* nx  length as  k 
              n'  set(sourcenodes as)"
    by(auto simp only:strong_postdominate_def)
  from paths2 obtain k2 
    where all2:"as nx. n'' -as→* nx  length as  k2  n'  set(sourcenodes as)"
    and "k2  1" by blast
  from n'' postdominates n n' postdominates n'' 
  have "n' postdominates n" by(rule postdominate_trans)
  { fix as nx assume "n -as→* nx" and "length as  k1 + k2"
    hence "length as  k1" by fastforce
    with n -as→* nx all1 obtain asx asx' where "n -asx→* n''"
      and "length asx < k1" and "n'' -asx'→* nx"
      and [simp]:"as = asx@asx'" by -(erule strong_postdominate_prop_smaller_path)
    with ‹length as  k1 + k2 have "length asx'  k2" by fastforce
    with n'' -asx'→* nx all2 have "n'  set(sourcenodes asx')" by fastforce
    hence "n'  set(sourcenodes as)" by(simp add:sourcenodes_def) }
  with k1  1 k2  1 have "k  1. as nx. n -as→* nx  length as  k 
              n'  set(sourcenodes as)"
    by(rule_tac x="k1 + k2" in exI,auto)
  with n' postdominates n show ?thesis by(simp add:strong_postdominate_def)
qed


lemma strong_postdominate_antisym:
  "n' strongly-postdominates n; n strongly-postdominates n'  n = n'"
by(fastforce intro:postdominate_antisym simp:strong_postdominate_def)


lemma strong_postdominate_path_branch:
  assumes "n -as→* n''" and "n' strongly-postdominates n''" 
  and "¬ n' strongly-postdominates n"
  obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
  and "¬ n' strongly-postdominates (sourcenode a)" 
  and "n' strongly-postdominates (targetnode a)"
proof(atomize_elim)
  from assms
  show "as' a as''. as = as'@a#as''  valid_edge a  
    ¬ n' strongly-postdominates (sourcenode a)  
      n' strongly-postdominates (targetnode a)"
  proof(induct rule:path.induct)
    case (Cons_path n'' as nx a n)
    note IH = n' strongly-postdominates nx; ¬ n' strongly-postdominates n''
       as' a as''. as = as'@a#as''  valid_edge a 
        ¬ n' strongly-postdominates sourcenode a  
          n' strongly-postdominates targetnode a
    show ?case
    proof(cases "n' strongly-postdominates n''")
      case True
      with ¬ n' strongly-postdominates n sourcenode a = n targetnode a = n''
        valid_edge a
      show ?thesis by blast
    next
      case False
      from IH[OF n' strongly-postdominates nx this] show ?thesis
        by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
    qed
  qed simp
qed


lemma Exit_no_strong_postdominator:
  "(_Exit_) strongly-postdominates n; n -as→* (_Exit_)  False"
by(fastforce intro:Exit_no_postdominator path_valid_node simp:strong_postdominate_def)


lemma strong_postdominate_path_targetnode:
  assumes "n' strongly-postdominates n" and "n -as→* n''"
  and "n'  set(sourcenodes as)"
  shows "n' strongly-postdominates n''"
proof -
  from n' strongly-postdominates n have "n' postdominates n"
    and "k  1. as nx. n -as→* nx  length as  k 
              n'  set(sourcenodes as)"
    by(auto simp only:strong_postdominate_def)
  then obtain k where "k  1"
    and paths:"as nx. n -as→* nx  length as  k 
                          n'  set(sourcenodes as)" by auto
  from n' postdominates n n -as→* n'' n'  set(sourcenodes as)
  have "n' postdominates n''"
    by(rule postdominate_path_targetnode)
  { fix as' nx assume "n'' -as'→* nx" and "length as'  k"
    with n -as→* n'' have "n -as@as'→* nx" and "length (as@as')  k"
      by(auto intro:path_Append)
    with paths have "n'  set(sourcenodes (as@as'))" by fastforce
    with n'  set(sourcenodes as) have "n'  set(sourcenodes as')"
      by(fastforce simp:sourcenodes_def) }
  with k  1 have "k  1. as' nx. n'' -as'→* nx  length as'  k 
              n'  set(sourcenodes as')" by auto
  with n' postdominates n'' show ?thesis by(simp add:strong_postdominate_def)
qed


lemma not_strong_postdominate_successor_set:
  assumes "¬ n strongly-postdominates (sourcenode a)" and "valid_node n"
  and "valid_edge a"
  and all:"nx  N. a'. valid_edge a'  sourcenode a' = sourcenode a 
    targetnode a' = nx  n strongly-postdominates nx"
  obtains a' where "valid_edge a'" and "sourcenode a' =  sourcenode a"
  and "targetnode a'  N"
proof(atomize_elim)
  show "a'. valid_edge a'  sourcenode a' =  sourcenode a  targetnode a'  N"
  proof(cases "n postdominates (sourcenode a)")
    case False
    with valid_edge a ‹valid_node n
    obtain a' where [simp]:"sourcenode a = sourcenode a'"
      and "valid_edge a'" and "¬ n postdominates targetnode a'"
      by -(erule not_postdominate_source_not_postdominate_target)
    with all have "targetnode a'  N" by(auto simp:strong_postdominate_def)
    with valid_edge a' show ?thesis by simp blast
  next
    case True
    let ?M = "{n'. a'. valid_edge a'  sourcenode a' =  sourcenode a  
                         targetnode a' = n'}"
    let ?M' = "{n'. a'. valid_edge a'  sourcenode a' =  sourcenode a  
                          targetnode a' = n'  n strongly-postdominates n'}"
    let ?N' = "(λn'. SOME i. i  1  
      (as nx. n' -as→* nx  length as  i 
                                 n  set(sourcenodes as))) ` N"
    obtain k where [simp]:"k = Max ?N'" by simp
    have eq:"{x  ?M. (λn'. n strongly-postdominates n') x} = ?M'" by auto
    from valid_edge a have "finite ?M" by(simp add:successor_set_finite)
    hence "finite {x  ?M. (λn'. n strongly-postdominates n') x}" by fastforce
    with eq have "finite ?M'" by simp
    from all have "N  ?M'" by auto
    with ‹finite ?M' have "finite N" by(auto intro:finite_subset)
    hence "finite ?N'" by fastforce
    show ?thesis
    proof(rule ccontr)
      assume "¬ (a'. valid_edge a'  sourcenode a' = sourcenode a  
                      targetnode a'  N)"
      hence allImp:"a'. valid_edge a'  sourcenode a' = sourcenode a
                          targetnode a'  N" by blast
      from True ¬ n strongly-postdominates (sourcenode a)
      have allPaths:"k  1. as nx. sourcenode a -as→* nx  length as  k 
         n  set(sourcenodes as)" by(auto simp:strong_postdominate_def)
      then obtain as nx where "sourcenode a -as→* nx"
        and "length as  k + 1" and "n  set(sourcenodes as)"
        by (erule_tac x="k + 1" in allE) auto
      then obtain ax as' where [simp]:"as = ax#as'" and "valid_edge ax"
        and "sourcenode ax = sourcenode a" and "targetnode ax -as'→* nx"
        by -(erule path.cases,auto)
      with allImp have "targetnode ax  N" by fastforce
      with all have "n strongly-postdominates (targetnode ax)"
        by auto
      then obtain k' where k':"k' = (SOME i. i  1 
        (as nx. targetnode ax -as→* nx  length as  i 
                  n  set(sourcenodes as)))" by simp
      with n strongly-postdominates (targetnode ax)
      have "k'  1  (as nx. targetnode ax -as→* nx  length as  k'
         n  set(sourcenodes as))"
        by(auto elim!:someI_ex simp:strong_postdominate_def)
      hence "k'  1"
        and spdAll:"as nx. targetnode ax -as→* nx  length as  k'
         n  set(sourcenodes as)"
        by simp_all
      from targetnode ax  N k' have "k'  ?N'" by blast
      with targetnode ax  N have "?N'  {}" by auto
      with k'  ?N' have "k'  Max ?N'" using ‹finite ?N' by(fastforce intro:Max_ge)
      hence "k'  k" by simp
      with targetnode ax -as'→* nx ‹length as  k + 1 spdAll 
      have "n  set(sourcenodes as')"
        by fastforce
      with n  set(sourcenodes as) show False by(simp add:sourcenodes_def)
    qed
  qed
qed



lemma not_strong_postdominate_predecessor_successor:
  assumes "¬ n strongly-postdominates (sourcenode a)"
  and "valid_node n" and "valid_edge a"
  obtains a' where "valid_edge a'" and "sourcenode a' = sourcenode a"
  and "¬ n strongly-postdominates (targetnode a')"
proof(atomize_elim)
  show "a'. valid_edge a'  sourcenode a' = sourcenode a  
             ¬ n strongly-postdominates (targetnode a')"
  proof(rule ccontr)
    assume "¬ (a'. valid_edge a'  sourcenode a' = sourcenode a 
            ¬ n strongly-postdominates targetnode a')"
    hence all:"a'. valid_edge a'  sourcenode a' = sourcenode a  
                    n strongly-postdominates (targetnode a')" by auto
    let ?N = "{n'. a'. sourcenode a' =  sourcenode a  valid_edge a'  
                        targetnode a' = n'}"
    from all have "nx  ?N. a'. valid_edge a'  sourcenode a' = sourcenode a  
      targetnode a' = nx  n strongly-postdominates nx"
      by auto
    with assms obtain a' where "valid_edge a'" 
      and "sourcenode a' =  sourcenode a" and "targetnode a'  ?N"
      by(erule not_strong_postdominate_successor_set)
    thus False by auto
  qed
qed


end


end

Theory CFG_wf

section ‹CFG well-formedness›

theory CFG_wf imports CFG begin

subsection ‹Well-formedness of the abstract CFG›

locale CFG_wf = CFG sourcenode targetnode kind valid_edge Entry
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") +
  fixes Def::"'node  'var set"
  fixes Use::"'node  'var set"
  fixes state_val::"'state  'var  'val"
  assumes Entry_empty:"Def (_Entry_) = {}  Use (_Entry_) = {}"
  and CFG_edge_no_Def_equal:
    "valid_edge a; V  Def (sourcenode a); pred (kind a) s
      state_val (transfer (kind a) s) V = state_val s V"
  and CFG_edge_transfer_uses_only_Use:
    "valid_edge a; V  Use (sourcenode a). state_val s V = state_val s' V;
      pred (kind a) s; pred (kind a) s'
       V  Def (sourcenode a). state_val (transfer (kind a) s) V =
                                     state_val (transfer (kind a) s') V"
  and CFG_edge_Uses_pred_equal:
    "valid_edge a; pred (kind a) s; 
      V  Use (sourcenode a). state_val s V = state_val s' V
        pred (kind a) s'"
  and deterministic:"valid_edge a; valid_edge a'; sourcenode a = sourcenode a';
    targetnode a  targetnode a' 
   Q Q'. kind a = (Q)  kind a' = (Q')  
             (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"

begin

lemma [dest!]: "V  Use (_Entry_)  False"
by(simp add:Entry_empty)

lemma [dest!]: "V  Def (_Entry_)  False"
by(simp add:Entry_empty)


lemma CFG_path_no_Def_equal:
  "n -as→* n'; n  set (sourcenodes as). V  Def n; preds (kinds as) s 
     state_val (transfers (kinds as) s) V = state_val s V"
proof(induct arbitrary:s rule:path.induct)
  case (empty_path n)
  thus ?case by(simp add:sourcenodes_def kinds_def)
next
  case (Cons_path n'' as n' a n)
  note IH = s. nset (sourcenodes as). V  Def n; preds (kinds as) s 
            state_val (transfers (kinds as) s) V = state_val s V
  from ‹preds (kinds (a#as)) s have "pred (kind a) s"
    and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
  from nset (sourcenodes (a#as)). V  Def n
    have noDef:"V  Def (sourcenode a)" 
    and all:"nset (sourcenodes as). V  Def n"
    by(auto simp:sourcenodes_def)
  from valid_edge a noDef ‹pred (kind a) s
  have "state_val (transfer (kind a) s) V = state_val s V"
    by(rule CFG_edge_no_Def_equal)
  with IH[OF all ‹preds (kinds as) (transfer (kind a) s)] show ?case
    by(simp add:kinds_def)
qed

end


end

Theory CFGExit_wf

theory CFGExit_wf imports CFGExit CFG_wf begin

subsection ‹New well-formedness lemmas using (_Exit_)›


locale CFGExit_wf = 
  CFG_wf sourcenode targetnode kind valid_edge Entry Def Use state_val +
  CFGExit sourcenode targetnode kind valid_edge Entry Exit 
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')") +
  assumes Exit_empty:"Def (_Exit_) = {}  Use (_Exit_) = {}"

begin

lemma Exit_Use_empty [dest!]: "V  Use (_Exit_)  False"
by(simp add:Exit_empty)

lemma Exit_Def_empty [dest!]: "V  Def (_Exit_)  False"
by(simp add:Exit_empty)

end

end

Theory SemanticsCFG

section ‹CFG and semantics conform›

theory SemanticsCFG imports CFG begin

locale CFG_semantics_wf = CFG sourcenode targetnode kind valid_edge Entry
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") +
  fixes sem::"'com  'state  'com  'state  bool" 
    ("((1_,/_) / (1_,/_))" [0,0,0,0] 81)
  fixes identifies::"'node  'com  bool" ("_  _" [51,0] 80)
  assumes fundamental_property:
    "n  c; c,s  c',s' 
      n' as. n -as→* n'  transfers (kinds as) s = s'  preds (kinds as) s 
               n'  c'"


end

Theory DynDataDependence

section ‹Dynamic data dependence›

theory DynDataDependence imports CFG_wf begin

context CFG_wf begin 

definition dyn_data_dependence :: 
  "'node  'var  'node  'edge list  bool" ("_ influences _ in _ via _" [51,0,0])
where "n influences V in n' via as 
    ((V  Def n)  (V  Use n')  (n -as→* n')  
     (a' as'. (as = a'#as')  (n''  set (sourcenodes as'). V  Def n'')))"


lemma dyn_influence_Cons_source:
  "n influences V in n' via a#as  sourcenode a = n"
  by(simp add:dyn_data_dependence_def,auto elim:path.cases)


lemma dyn_influence_source_notin_tl_edges: 
  assumes "n influences V in n' via a#as"
  shows "n  set (sourcenodes as)"
proof(rule ccontr)
  assume "¬ n  set (sourcenodes as)"
  hence "n  set (sourcenodes as)" by simp
  from n influences V in n' via a#as have "n''  set (sourcenodes as). V  Def n''"
    and "V  Def n" by(simp_all add:dyn_data_dependence_def)
  from n''  set (sourcenodes as). V  Def n'' 
    n  set (sourcenodes as) have "V  Def n" by simp
  with V  Def n show False by simp
qed


lemma dyn_influence_only_first_edge:
  assumes "n influences V in n' via a#as" and "preds (kinds (a#as)) s"
  shows "state_val (transfers (kinds (a#as)) s) V = 
         state_val (transfer (kind a) s) V"
proof -
  from ‹preds (kinds (a#as)) s have "preds (kinds as) (transfer (kind a) s)"
    by(simp add:kinds_def)
  from n influences V in n' via a#as have "n -a#as→* n'"
    and "n''  set (sourcenodes as). V  Def n''"
    by(simp_all add:dyn_data_dependence_def)
  from n -a#as→* n' have "n = sourcenode a" and "targetnode a -as→* n'"
    by(auto elim:path_split_Cons)
  from n influences V in n' via a#as n = sourcenode a 
  have "sourcenode a  set (sourcenodes as)"
    by(fastforce intro!:dyn_influence_source_notin_tl_edges)
  { fix n'' assume "n''  set (sourcenodes as)"
    with sourcenode a  set (sourcenodes as) n = sourcenode a 
    have "n''  n" by(fastforce simp:sourcenodes_def)
    with n''  set (sourcenodes as). V  Def n'' n''  set (sourcenodes as)
    have "V  Def n''" by(auto simp:sourcenodes_def) }
  hence "n''  set (sourcenodes as). V  Def n''" by simp
  with targetnode a -as→* n' ‹preds (kinds as) (transfer (kind a) s)
  have "state_val (transfers (kinds as) (transfer (kind a) s)) V = 
        state_val (transfer (kind a) s) V"
    by -(rule CFG_path_no_Def_equal)
  thus ?thesis by(auto simp:kinds_def)
qed

end

end

Theory DynStandardControlDependence

section ‹Dynamic Standard Control Dependence›

theory DynStandardControlDependence imports Postdomination begin

context Postdomination begin

definition
  dyn_standard_control_dependence :: "'node  'node  'edge list  bool"
  ("_ controlss _ via _" [51,0,0])
where dyn_standard_control_dependence_def:"n controlss n' via as  
    (a a' as'. (as = a#as')  (n'  set(sourcenodes as))  (n -as→* n') 
                   (n' postdominates (targetnode a)) 
                   (valid_edge a')  (sourcenode a' = n)  
                   (¬ n' postdominates (targetnode a')))"


lemma Exit_not_dyn_standard_control_dependent:
  assumes control:"n controlss (_Exit_) via as" shows "False"
proof -
  from control obtain a as' where path:"n -as→* (_Exit_)" and as:"as = a#as'"
    and pd:"(_Exit_) postdominates (targetnode a)" 
    by(auto simp:dyn_standard_control_dependence_def)
  from path as have "n -[]@a#as'→* (_Exit_)" by simp
  hence "valid_edge a" by(fastforce dest:path_split)
  with pd show False by -(rule Exit_no_postdominator,auto)
qed


lemma dyn_standard_control_dependence_def_variant:
  "n controlss n' via as = ((n -as→* n')  (n  n') 
    (¬ n' postdominates n)  (n'  set(sourcenodes as)) 
  (n''  set(targetnodes as). n' postdominates n''))"
proof
  assume "(n -as→* n')  (n  n')  (¬ n' postdominates n)  
    (n'  set(sourcenodes as)) 
    (n''set (targetnodes as). n' postdominates n'')"
  hence path:"n -as→* n'" and noteq:"n  n'"
    and not_pd:"¬ n' postdominates n"
    and notin:"n'  set(sourcenodes as)"
    and all:"n''set (targetnodes as). n' postdominates n''"
    by auto
  have notExit:"n  (_Exit_)"
  proof
    assume "n = (_Exit_)"
    with path have "n = n'" by(fastforce dest:path_Exit_source)
    with noteq show False by simp
  qed
  from path have valid:"valid_node n" and valid':"valid_node n'"
    by(auto dest:path_valid_node)
  show "n controlss n' via as"
  proof(cases as)
    case Nil    
    with path valid not_pd notExit have False 
      by(fastforce elim:path.cases dest:postdominate_refl)
    thus ?thesis by simp
  next
    case (Cons ax asx)
    with all have pd:"n' postdominates targetnode ax"
      by(auto simp:targetnodes_def)
    from path Cons have source:"n = sourcenode ax" 
      and path2:"targetnode ax -asx→* n'"
      by(auto intro:path_split_Cons)
    show ?thesis
    proof(cases "as'. n -as'→* (_Exit_)")
      case True
      with not_pd valid valid' obtain as' where path':"n -as'→* (_Exit_)"
        and not_isin:"n'  set (sourcenodes as')"
        by(auto simp:postdominate_def)
      have "as'  []"
      proof
        assume "as' = []"
        with path' have "n = (_Exit_)" by(auto elim:path.cases)
        with notExit show False by simp
      qed
      then obtain a' as'' where as':"as' = a'#as''"
        by(cases as',auto elim:path.cases)
      with path' have "n -[]@a'#as''→* (_Exit_)" by simp
      hence source':"n = sourcenode a'" 
        and valid_edge:"valid_edge a'"
        and path2':"targetnode a' -as''→* (_Exit_)"
        by(fastforce dest:path_split)+
      from path2' not_isin as' valid'
      have "¬ n' postdominates (targetnode a')"
        by(auto simp:postdominate_def sourcenodes_def)
      with pd path Cons source source' notin valid_edge show ?thesis
        by(auto simp:dyn_standard_control_dependence_def)
    next
      case False
      with valid valid' have "n' postdominates n"
        by(auto simp:postdominate_def)
      with not_pd have False by simp
      thus ?thesis by simp
    qed
  qed
next
  assume "n controlss n' via as"
  then obtain a nx a' nx' as' where notin:"n'  set(sourcenodes as)"
    and path:"n -as→* n'" and as:"as = a#as'" and valid_edge:"valid_edge a'"
    and pd:"n' postdominates (targetnode a)"
    and source':"sourcenode a' = n"
    and not_pd:"¬ n' postdominates (targetnode a')"
    by(auto simp:dyn_standard_control_dependence_def)
  from path as have source:"sourcenode a = n" by(auto elim:path.cases)
  from path as have notExit:"n  (_Exit_)" by(auto elim:path.cases)
  from path have valid:"valid_node n" and valid':"valid_node n'"
    by(auto dest:path_valid_node)
  from notin as source have noteq:"n  n'"
    by(fastforce simp:sourcenodes_def)
  from valid_edge have valid_target':"valid_node (targetnode a')"
    by(fastforce simp:valid_node_def)
  { assume pd':"n' postdominates n"
    hence all:"as. n -as→* (_Exit_)  n'  set (sourcenodes as)"
      by(auto simp:postdominate_def)
    from not_pd valid' valid_target' obtain as' 
      where "targetnode a' -as'→* (_Exit_)"
      by(auto simp:postdominate_def)
    with source' valid_edge have path':"n -a'#as'→* (_Exit_)"
      by(fastforce intro:Cons_path)
    with all have "n'  set (sourcenodes (a'#as'))" by blast
    with source' have "n' = n  n'  set (sourcenodes as')"
      by(fastforce simp:sourcenodes_def)
    hence False
    proof
      assume "n' = n"
      with noteq show ?thesis by simp
    next
      assume isin:"n'  set (sourcenodes as')"
      from path' have path2:"targetnode a' -as'→* (_Exit_)"
        by(fastforce elim:path_split_Cons)
      thus ?thesis
      proof(cases "as' = []")
        case True
        with path2 have "targetnode a' = (_Exit_)" by(auto elim:path.cases)
        with valid_edge all source' have "n' = n"
          by(fastforce dest:path_edge simp:sourcenodes_def)
        with noteq show ?thesis by simp
      next
        case False
        from path2 not_pd valid' valid_edge obtain as''
          where path'':"targetnode a' -as''→* (_Exit_)"
          and notin:"n'  set (sourcenodes as'')"
          by(auto simp:postdominate_def)
        from valid_edge path'' have "sourcenode a' -a'#as''→* (_Exit_)"
          by(fastforce intro:Cons_path)
        with all source' have "n'  set (sourcenodes ([a']@as''))" by simp
        with source' have "n' = n  n'  set (sourcenodes as'')"
          by(auto simp:sourcenodes_def)
        thus ?thesis
        proof
          assume "n' = n"
          with noteq show ?thesis by simp
        next
          assume "n'  set (sourcenodes as'')"
          with notin show ?thesis by simp
        qed
      qed
    qed }
  hence not_pd':"¬ n' postdominates n" by blast
  { fix n'' assume "n''  set (targetnodes as)"
    with as source have "n'' = targetnode a  n''  set (targetnodes as')" 
      by(auto simp:targetnodes_def)
    hence "n' postdominates n''"
    proof
      assume "n'' = targetnode a"
      with pd show ?thesis by simp
    next
      assume isin:"n''  set (targetnodes as')"
      hence "ni  set (targetnodes as'). ni = n''" by simp
      then obtain ns ns' where targets:"targetnodes as' = ns@n''#ns'"
        and all_noteq:"ni  set ns'. ni  n''"
        by(fastforce elim!:rightmost_element_property)
      from targets obtain xs ax ys where ys:"ns' = targetnodes ys"
        and as':"as' = xs@ax#ys" and target'':"targetnode ax = n''"
        by(fastforce elim:map_append_append_maps simp:targetnodes_def)
      from all_noteq ys have notin_target:"n''  set(targetnodes ys)"
        by auto
      from path as have "n -[]@a#as'→* n'" by simp
      hence "targetnode a -as'→* n'" 
        by(fastforce dest:path_split)
      with isin have path':"targetnode a -as'→* n'"
        by(fastforce split:if_split_asm simp:targetnodes_def)
      with as' target'' have path1:"targetnode a -xs→* sourcenode ax"
        and valid_edge':"valid_edge ax"
        and path2:"n'' -ys→* n'"
        by(auto intro:path_split)
      from valid_edge' have "sourcenode ax -[ax]→* targetnode ax" by(rule path_edge)
      with path1 target'' have path_n'':"targetnode a -xs@[ax]→* n''"
        by(fastforce intro:path_Append)
      from notin as as' have notin':"n' set (sourcenodes (xs@[ax]))"
        by(simp add:sourcenodes_def)
      show ?thesis
      proof(rule ccontr)
        assume "¬ n' postdominates n''"
        with valid' target'' valid_edge' obtain asx' 
          where Exit_path:"n'' -asx'→* (_Exit_)"
          and notin'':"n'  set(sourcenodes asx')" by(auto simp:postdominate_def)
        from path_n'' Exit_path
        have Exit_path':"targetnode a -(xs@[ax])@asx'→* (_Exit_)"
          by(fastforce intro:path_Append)
        from notin' notin'' have "n'  set(sourcenodes (xs@ax#asx'))"
          by(simp add:sourcenodes_def)
        with pd Exit_path' show False by(simp add:postdominate_def)
      qed
    qed }
  with path not_pd' notin noteq show "(n -as→* n')  (n  n') 
    (¬ n' postdominates n)  (n'  set(sourcenodes as)) 
    (n''  set(targetnodes as). n' postdominates n'')" by blast
qed


lemma which_node_dyn_standard_control_dependence_source:
  assumes path:"(_Entry_) -as@a#as'→* n"
  and Exit_path:"n -as''→* (_Exit_)" and source:"sourcenode a = n'" 
  and source':"sourcenode a' = n'"
  and no_source:"n  set(sourcenodes (a#as'))" and valid_edge':"valid_edge a'"
  and inner_node:"inner_node n" and not_pd:"¬ n postdominates (targetnode a')"
  and last:"ax ax'. ax  set as'  sourcenode ax = sourcenode ax' 
    valid_edge ax'  n postdominates targetnode ax'"
  shows "n' controlss n via a#as'"
proof -
  from path source have path_n'n:"n' -a#as'→* n" by(fastforce dest:path_split_second)
  from path have valid_edge:"valid_edge a" by(fastforce intro:path_split)
  show ?thesis
  proof(cases "n postdominates (targetnode a)")
    case True
    with path_n'n not_pd no_source source source' valid_edge' show ?thesis
      by(auto simp:dyn_standard_control_dependence_def)
  next
    case False
    hence not_pd':"¬ n postdominates (targetnode a)" .
    show ?thesis
    proof(cases "as' = []")
      case True
      with path_n'n have "targetnode a = n" by(fastforce elim:path.cases)
      with inner_node have "n postdominates (targetnode a)"
        by(cases "n = (_Exit_)",auto intro:postdominate_refl simp:inner_node_def)
      with not_pd path_n'n no_source source source' valid_edge' show ?thesis
        by(fastforce simp:dyn_standard_control_dependence_def)
    next
      case False
      hence notempty':"as'  []" .
      with path have path_nxn:"targetnode a -as'→* n"
        by(fastforce dest:path_split)
      from Exit_path path_nxn have "as. targetnode a -as→* (_Exit_)"
        by(fastforce dest:path_Append)
      with not_pd' inner_node valid_edge obtain asx 
        where path_Exit:"targetnode a -asx→* (_Exit_)" 
        and notin:"n  set (sourcenodes asx)"
        by(auto simp:postdominate_def inner_is_valid)
      show ?thesis
      proof(cases "asx'. asx = as'@asx'")
        case True
        then obtain asx' where asx:"asx = as'@asx'" by blast
        from path notempty' have "targetnode a -as'→* n"
          by(fastforce dest:path_split)
        with path_Exit inner_node asx notempty'
        obtain a'' as'' where "asx' = a''#as''  sourcenode a'' = n"
          apply(cases asx')
           apply(fastforce dest:path_det)
          by(fastforce dest:path_split path_det)
        with asx have "n  set(sourcenodes asx)" by(simp add:sourcenodes_def)
        with notin have False by simp
        thus ?thesis by simp
      next
        case False
        hence all:"asx'. asx  as'@asx'" by simp
        then obtain j asx' where asx:"asx = (take j as')@asx'"
          and length:"j < length as'"
          and not_more:"k > j. asx''. asx  (take k as')@asx''"
          by(auto elim:path_split_general)
        from asx length have "as'1 as'2. asx = as'1@asx'  
          as' = as'1@as'2  as'2  []  as'1 = take j as'"
          by simp(rule_tac x= "drop j as'" in exI,simp)
        then obtain as'1 as'' where asx:"asx = as'1@asx'"
          and take:"as'1 = take j as'"
          and x:"as' = as'1@as''" and x':"as''  []" by blast
        from x x' obtain a1 as'2 where as':"as' = as'1@a1#as'2" and "as'' = a1#as'2"
          by(cases as'') auto
        have notempty_x':"asx'  []"
        proof(cases "asx' = []")
          case True
          with asx as' have "as' = asx@a1#as'2" by simp
          with path_n'n have "n' -(a#asx)@a1#as'2→* n"
            by simp
          hence "n' -a#asx→* sourcenode a1"
            and valid_edge1:"valid_edge a1" by(fastforce elim:path_split)+
          hence "targetnode a -asx→* sourcenode a1"
            by(fastforce intro:path_split_Cons)
          with path_Exit have "(_Exit_) = sourcenode a1" by(rule path_det)
          from this[THEN sym] valid_edge1 have False by -(rule Exit_source,simp_all)
          thus ?thesis by simp
        qed simp
        with asx obtain a2 asx'1 
          where asx:"asx = as'1@a2#asx'1"
          and asx':"asx' = a2#asx'1" by(cases asx') auto
        from path_n'n as' have "n' -(a#as'1)@a1#as'2→* n" by simp
        hence "n' -a#as'1→* sourcenode a1" and valid_edge1:"valid_edge a1"
          by(fastforce elim:path_split)+
        hence path1:"targetnode a -as'1→* sourcenode a1"
          by(fastforce intro:path_split_Cons)
        from path_Exit asx
        have "targetnode a -as'1→* sourcenode a2"
          and valid_edge2:"valid_edge a2"
          and path2:"targetnode a2 -asx'1→* (_Exit_)"
          by(auto intro:path_split)
        with path1 have eq12:"sourcenode a1 = sourcenode a2"
          by(cases as'1,auto dest:path_det)
        from asx notin have "n  set (sourcenodes asx'1)"
          by(simp add:sourcenodes_def)
        with path2 have not_pd'2:"¬ n postdominates targetnode a2"
          by(cases "asx'1 = []",auto simp:postdominate_def)
        from as' have "a1  set as'" by simp
        with eq12 last valid_edge2 have "n postdominates targetnode a2" by blast
        with not_pd'2 have False by simp
        thus ?thesis by simp
      qed
    qed
  qed
qed


lemma inner_node_dyn_standard_control_dependence_predecessor:
  assumes inner_node:"inner_node n"
  obtains n' as where "n' controlss n via as"
proof(atomize_elim)
  from inner_node obtain as' where pathExit:"n -as'→* (_Exit_)"
    by(fastforce dest:inner_is_valid Exit_path)
  from inner_node obtain as where pathEntry:"(_Entry_) -as→* n"
    by(fastforce dest:inner_is_valid Entry_path)
  with inner_node have notEmpty:"as  []" 
    by(auto elim:path.cases simp:inner_node_def)
  have "a asx. (_Entry_) -a#asx→* n  n  set (sourcenodes (a#asx))"
  proof(cases "n  set (sourcenodes as)")
    case True
    hence "n''  set(sourcenodes as). n = n''" by simp
    then obtain ns' ns'' where nodes:"sourcenodes as = ns'@n#ns''"
      and notin:"n''  set ns'. n  n''"
      by(fastforce elim!:split_list_first_propE)
    from nodes obtain xs ys a'
      where xs:"sourcenodes xs = ns'" and as:"as = xs@a'#ys"
      and source:"sourcenode a' = n"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from pathEntry as have "(_Entry_) -xs@a'#ys→* n" by simp
    hence path2:"(_Entry_) -xs→* sourcenode a'"
      by(fastforce dest:path_split)
    show ?thesis
    proof(cases "xs = []")
      case True
      with path2 have "(_Entry_) = sourcenode a'" by(auto elim:path.cases)
      with pathEntry source notEmpty have "(_Entry_) -as→* (_Entry_)  as  []"
        by(auto elim:path.cases)
      hence False by(fastforce dest:path_Entry_target)
      thus ?thesis by simp
    next
      case False
      then obtain n a'' xs' where "xs = a''#xs'" by(cases xs) auto
      with False path2 notin xs source show ?thesis by simp blast
    qed
  next
    case False
    from notEmpty obtain a as' where "as = a#as'" by (cases as) auto
    with False pathEntry show ?thesis by auto
  qed
  then obtain a asx where pathEntry':"(_Entry_) -a#asx→* n"
    and notin:"n  set (sourcenodes (a#asx))" by blast
  show "n' as. n' controlss n via as"
  proof(cases "a' a''. a'  set asx  sourcenode a' = sourcenode a''  
      valid_edge a''  n postdominates targetnode a''")
    case True
    from inner_node have not_pd:"¬ n postdominates (_Exit_)" 
      by(fastforce intro:empty_path simp:postdominate_def sourcenodes_def)
    from pathEntry' have path':"(_Entry_) -[]@a#asx→* n" by simp
    hence eq:"sourcenode a = (_Entry_)"
      by(fastforce dest:path_split elim:path.cases)
    from Entry_Exit_edge obtain a' where "sourcenode a' = (_Entry_)"
      and "targetnode a' = (_Exit_)" and "valid_edge a'" by auto
    with path' inner_node not_pd True eq notin pathExit
    have "sourcenode a controlss n via a#asx"
      by -(erule which_node_dyn_standard_control_dependence_source,auto)
    thus ?thesis by blast
  next
    case False
    hence "a'  set asx. a''. sourcenode a' = sourcenode a''  valid_edge a'' 
      ¬ n postdominates targetnode a''"
      by fastforce
    then obtain ax asx' asx'' where "asx = asx'@ax#asx'' 
      (a''. sourcenode ax = sourcenode a''  valid_edge a'' 
      ¬ n postdominates targetnode a'') 
      (z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  valid_edge a'' 
      ¬ n postdominates targetnode a''))"
      by(blast elim!:rightmost_element_property)
    then obtain a'' where as':"asx = asx'@ax#asx''"
      and eq:"sourcenode ax = sourcenode a''"
      and valid_edge:"valid_edge a''"
      and not_pd:"¬ n postdominates targetnode a''"
      and last:"z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  
        valid_edge a''  ¬ n postdominates targetnode a'')"
      by blast
    from notin as' have notin':"n  set (sourcenodes (ax#asx''))"
      by(auto simp:sourcenodes_def)
    from as' pathEntry' have "(_Entry_) -(a#asx')@ax#asx''→* n" by simp
    with inner_node not_pd notin' eq last pathExit valid_edge
    have "sourcenode ax controlss n via ax#asx''"
      by(fastforce elim!:which_node_dyn_standard_control_dependence_source)
    thus ?thesis by blast
  qed
qed


end

end

Theory DynWeakControlDependence

section ‹Dynamic Weak Control Dependence›

theory DynWeakControlDependence imports Postdomination begin

context StrongPostdomination begin

definition
  dyn_weak_control_dependence :: "'node  'node  'edge list  bool" 
  ("_ weakly controls _ via _" [51,0,0])
where dyn_weak_control_dependence_def:"n weakly controls n' via as  
    (a a' as'. (as = a#as')  (n'  set(sourcenodes as))  (n -as→* n') 
                   (n' strongly-postdominates (targetnode a)) 
                   (valid_edge a')  (sourcenode a' = n)  
                   (¬ n' strongly-postdominates (targetnode a')))"


lemma Exit_not_dyn_weak_control_dependent:
  assumes control:"n weakly controls (_Exit_) via as" shows "False"
proof -
  from control obtain as a as' where path:"n -as→* (_Exit_)" and as:"as = a#as'"
    and pd:"(_Exit_) postdominates (targetnode a)"
    by(auto simp:dyn_weak_control_dependence_def strong_postdominate_def)
  from path as have "n -[]@a#as'→* (_Exit_)" by simp
  hence "valid_edge a" by(fastforce dest:path_split)
  with pd show False by -(rule Exit_no_postdominator,auto)
qed

end

end

Theory DynPDG

chapter ‹Dynamic Slicing›

section ‹Dynamic Program Dependence Graph›

theory DynPDG imports 
  "../Basic/DynDataDependence" 
  "../Basic/CFGExit_wf" 
  "../Basic/DynStandardControlDependence"
  "../Basic/DynWeakControlDependence"
begin

subsection ‹The dynamic PDG›

locale DynPDG = 
  CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')") +
  fixes dyn_control_dependence :: "'node  'node  'edge list  bool" 
("_ controls _ via _" [51,0,0])
  assumes Exit_not_dyn_control_dependent:"n controls n' via as  n'  (_Exit_)"
  assumes dyn_control_dependence_path:
  "n controls n' via as   n -as→* n'  as  []"

begin

inductive cdep_edge :: "'node  'edge list  'node  bool" 
    ("_ -_cd _" [51,0,0] 80)
  and ddep_edge :: "'node  'var  'edge list  'node  bool"
    ("_ -'{_'}_dd _" [51,0,0,0] 80)
  and DynPDG_edge :: "'node  'var option  'edge list  'node  bool"

where
      ― ‹Syntax›
  "n -ascd n' == DynPDG_edge n None as n'"
  | "n -{V}asdd n' == DynPDG_edge n (Some V) as n'"

      ― ‹Rules›
  | DynPDG_cdep_edge:
  "n controls n' via as  n -ascd n'"

  | DynPDG_ddep_edge:
  "n influences V in n' via as  n -{V}asdd n'"


inductive DynPDG_path :: "'node  'edge list  'node  bool"
("_ -_d* _" [51,0,0] 80) 

where DynPDG_path_Nil:
  "valid_node n  n -[]d* n"

  | DynPDG_path_Append_cdep:
  "n -asd* n''; n'' -as'cd n'  n -as@as'd* n'"

  | DynPDG_path_Append_ddep:
  "n -asd* n''; n'' -{V}as'dd n'  n -as@as'd* n'"


lemma DynPDG_empty_path_eq_nodes:"n -[]d* n'  n = n'"
apply - apply(erule DynPDG_path.cases) 
  apply simp
 apply(auto elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)


lemma DynPDG_path_cdep:"n -ascd n'  n -asd* n'"
apply(subgoal_tac "n -[]@asd* n'")
 apply simp
apply(rule DynPDG_path_Append_cdep, rule DynPDG_path_Nil)
by(auto elim!:DynPDG_edge.cases dest:dyn_control_dependence_path path_valid_node)

lemma DynPDG_path_ddep:"n -{V}asdd n'  n -asd* n'"
apply(subgoal_tac "n -[]@asd* n'")
 apply simp
apply(rule DynPDG_path_Append_ddep, rule DynPDG_path_Nil)
by(auto elim!:DynPDG_edge.cases dest:path_valid_node simp:dyn_data_dependence_def)

lemma DynPDG_path_Append:
  "n'' -as'd* n'; n -asd* n''  n -as@as'd* n'"
apply(induct rule:DynPDG_path.induct)
  apply(auto intro:DynPDG_path.intros)
 apply(rotate_tac 1,drule DynPDG_path_Append_cdep,simp+)
apply(rotate_tac 1,drule DynPDG_path_Append_ddep,simp+)
done


lemma DynPDG_path_Exit:"n -asd* n'; n' = (_Exit_)  n = (_Exit_)"
apply(induct rule:DynPDG_path.induct)
by(auto elim:DynPDG_edge.cases dest:Exit_not_dyn_control_dependent 
        simp:dyn_data_dependence_def)


lemma DynPDG_path_not_inner:
  "n -asd* n'; ¬ inner_node n'  n = n'"
proof(induct rule:DynPDG_path.induct)
  case (DynPDG_path_Nil n)
  thus ?case by simp
next
  case (DynPDG_path_Append_cdep n as n'' as' n')
  from n'' -as'cd n' ¬ inner_node n' have False
    apply -
    apply(erule DynPDG_edge.cases) apply(auto simp:inner_node_def)
      apply(fastforce dest:dyn_control_dependence_path path_valid_node)
     apply(fastforce dest:dyn_control_dependence_path path_valid_node)
    by(fastforce dest:Exit_not_dyn_control_dependent)
  thus ?case by simp
next
  case (DynPDG_path_Append_ddep n as n'' V as' n')
  from n'' -{V}as'dd n' ¬ inner_node n' have False
    apply -
    apply(erule DynPDG_edge.cases) 
    by(auto dest:path_valid_node simp:inner_node_def dyn_data_dependence_def)
  thus ?case by simp
qed


lemma DynPDG_cdep_edge_CFG_path:
  assumes "n -ascd n'" shows "n -as→* n'" and "as  []"
  using n -ascd n'
  by(auto elim:DynPDG_edge.cases dest:dyn_control_dependence_path)

lemma DynPDG_ddep_edge_CFG_path:
  assumes "n -{V}asdd n'" shows "n -as→* n'" and "as  []"
  using n -{V}asdd n'
  by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)

lemma DynPDG_path_CFG_path:
  "n -asd* n'  n -as→* n'"
proof(induct rule:DynPDG_path.induct)
  case DynPDG_path_Nil thus ?case by(rule empty_path)
next
  case (DynPDG_path_Append_cdep n as n'' as' n')
  from n'' -as'cd n' have "n'' -as'→* n'"
    by(rule DynPDG_cdep_edge_CFG_path(1))
  with n -as→* n'' show ?case by(rule path_Append)
next
  case (DynPDG_path_Append_ddep n as n'' V as' n')
  from n'' -{V}as'dd n' have "n'' -as'→* n'"
    by(rule DynPDG_ddep_edge_CFG_path(1))
  with n -as→* n'' show ?case by(rule path_Append)
qed


lemma DynPDG_path_split: 
  "n -asd* n' 
  (as = []  n = n')  
  (n'' asx asx'. (n -asxcd n'')  (n'' -asx'd* n')  
        (as = asx@asx')) 
  (n'' V asx asx'. (n -{V}asxdd n'')  (n'' -asx'd* n')  
        (as = asx@asx'))"
proof(induct rule:DynPDG_path.induct)
  case (DynPDG_path_Nil n) thus ?case by auto
next
  case (DynPDG_path_Append_cdep n as n'' as' n')
  note IH = as = []  n = n'' 
    (nx asx asx'. n -asxcd nx  nx -asx'd* n''  as = asx@asx') 
    (nx V asx asx'. n -{V}asxdd nx  nx -asx'd* n''  as = asx@asx')
  from IH show ?case
  proof
    assume "as = []  n = n''"
    with n'' -as'cd n' have "valid_node n'"
      by(fastforce intro:path_valid_node(2) DynPDG_path_CFG_path 
                        DynPDG_path_cdep)
    with as = []  n = n'' n'' -as'cd n'
    have "n'' asx asx'. n -asxcd n''  n'' -asx'd* n'  as@as' = asx@asx'"
      by(auto intro:DynPDG_path_Nil)
    thus ?thesis by simp
  next
    assume "(nx asx asx'. n -asxcd nx  nx -asx'd* n''  as = asx@asx') 
      (nx V asx asx'. n -{V}asxdd nx  nx -asx'd* n''  as = asx@asx')"
    thus ?thesis
    proof
      assume "nx asx asx'. n -asxcd nx  nx -asx'd* n''  as = asx@asx'"
      then obtain nx asx asx' where "n -asxcd nx" and "nx -asx'd* n''"
        and "as = asx@asx'" by auto
      from n'' -as'cd n' have "n'' -as'd* n'" by(rule DynPDG_path_cdep)
      with nx -asx'd* n'' have "nx -asx'@as'd* n'"
        by(fastforce intro:DynPDG_path_Append)
      with n -asxcd nx as = asx@asx'
      have "n'' asx asx'. n -asxcd n''  n'' -asx'd* n'  as@as' = asx@asx'"
        by auto
      thus ?thesis by simp
    next
      assume "nx V asx asx'. n -{V}asxdd nx  nx -asx'd* n''  as = asx@asx'"
      then obtain nx V asx asx' where "n -{V}asxdd nx" and "nx -asx'd* n''"
        and "as = asx@asx'" by auto
      from n'' -as'cd n' have "n'' -as'd* n'" by(rule DynPDG_path_cdep)
      with nx -asx'd* n'' have "nx -asx'@as'd* n'"
        by(fastforce intro:DynPDG_path_Append)
      with n -{V}asxdd nx as = asx@asx'
      have "n'' V asx asx'. n -{V}asxdd n''  n'' -asx'd* n'  as@as' = asx@asx'"
        by auto
      thus ?thesis by simp
    qed
  qed
next
  case (DynPDG_path_Append_ddep n as n'' V as' n')
  note IH = as = []  n = n'' 
    (nx asx asx'. n -asxcd nx  nx -asx'd* n''  as = asx@asx') 
    (nx V asx asx'. n -{V}asxdd nx  nx -asx'd* n''  as = asx@asx')
  from IH show ?case
  proof
    assume "as = []  n = n''"
    with n'' -{V}as'dd n' have "valid_node n'"
      by(fastforce intro:path_valid_node(2) DynPDG_path_CFG_path 
                        DynPDG_path_ddep)
    with as = []  n = n'' n'' -{V}as'dd n'
    have "n'' V asx asx'. n -{V}asxdd n''  n'' -asx'd* n'  as@as' = asx@asx'"
      by(fastforce intro:DynPDG_path_Nil)
    thus ?thesis by simp
  next
    assume "(nx asx asx'. n -asxcd nx  nx -asx'd* n''  as = asx@asx') 
      (nx V asx asx'. n -{V}asxdd nx  nx -asx'd* n''  as = asx@asx')"
    thus ?thesis
    proof
      assume "nx asx asx'. n -asxcd nx  nx -asx'd* n''  as = asx@asx'"
      then obtain nx asx asx' where "n -asxcd nx" and "nx -asx'd* n''"
        and "as = asx@asx'" by auto
      from n'' -{V}as'dd n' have "n'' -as'd* n'" by(rule DynPDG_path_ddep)
      with nx -asx'd* n'' have "nx -asx'@as'd* n'"
        by(fastforce intro:DynPDG_path_Append)
      with n -asxcd nx as = asx@asx'
      have "n'' asx asx'. n -asxcd n''  n'' -asx'd* n'  as@as' = asx@asx'"
        by auto
      thus ?thesis by simp
    next
      assume "nx V asx asx'. n -{V}asxdd nx  nx -asx'd* n''  as = asx@asx'"
      then obtain nx V' asx asx' where "n -{V'}asxdd nx" and "nx -asx'd* n''"
        and "as = asx@asx'" by auto
      from n'' -{V}as'dd n' have "n'' -as'd* n'" by(rule DynPDG_path_ddep)
      with nx -asx'd* n'' have "nx -asx'@as'd* n'"
        by(fastforce intro:DynPDG_path_Append)
      with n -{V'}asxdd nx as = asx@asx'
      have "n'' V asx asx'. n -{V}asxdd n''  n'' -asx'd* n'  as@as' = asx@asx'"
        by auto
      thus ?thesis by simp
    qed
  qed
qed


lemma DynPDG_path_rev_cases [consumes 1,
  case_names DynPDG_path_Nil DynPDG_path_cdep_Append DynPDG_path_ddep_Append]:
  "n -asd* n'; as = []; n = n'  Q;
    n'' asx asx'. n -asxcd n''; n'' -asx'd* n'; 
                       as = asx@asx'  Q;
    V n'' asx asx'. n -{V}asxdd n''; n'' -asx'd* n'; 
                       as = asx@asx'  Q
   Q"
by(blast dest:DynPDG_path_split)



lemma DynPDG_ddep_edge_no_shorter_ddep_edge:
  assumes ddep:"n -{V}asdd n'"
  shows "as' a as''. tl as = as'@a#as''  ¬ sourcenode a -{V}a#as''dd n'"
proof -
  from ddep have influence:"n influences V in n' via as"
    by(auto elim!:DynPDG_edge.cases)
  then obtain  a asx where as:"as = a#asx"
    and notin:"n  set (sourcenodes asx)"
    by(auto dest:dyn_influence_source_notin_tl_edges simp:dyn_data_dependence_def)
  from influence as
  have imp:"nx  set (sourcenodes asx). V  Def nx"
    by(auto simp:dyn_data_dependence_def)
  { fix as' a' as'' 
    assume eq:"tl as = as'@a'#as''"
      and ddep':"sourcenode a' -{V}a'#as''dd n'"
    from eq as notin have noteq:"sourcenode a'  n" by(auto simp:sourcenodes_def)
    from ddep' have "V  Def (sourcenode a')"
      by(auto elim!:DynPDG_edge.cases simp:dyn_data_dependence_def)
    with eq as noteq imp have False by(auto simp:sourcenodes_def) }
  thus ?thesis by blast
qed



lemma no_ddep_same_state:
  assumes path:"n -as→* n'" and Uses:"V  Use n'" and preds:"preds (kinds as) s"
  and no_dep:"as' a as''. as = as'@a#as''  ¬ sourcenode a -{V}a#as''dd n'"
  shows "state_val (transfers (kinds as) s) V = state_val s V"
proof -
  { fix n''
    assume inset:"n''  set (sourcenodes as)" and Defs:"V  Def n''"
    hence "nx  set (sourcenodes as). V  Def nx" by auto
    then obtain nx ns' ns'' where nodes:"sourcenodes as = ns'@nx#ns''"
        and Defs':"V  Def nx" and notDef:"nx'  set ns''. V  Def nx'"
      by(fastforce elim!:rightmost_element_property)
    from nodes obtain as' a as''
      where as'':"sourcenodes as'' = ns''" and as:"as=as'@a#as''"
      and source:"sourcenode a = nx"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from as path have path':"sourcenode a -a#as''→* n'"
      by(fastforce dest:path_split_second)
    from notDef as'' source
    have "n''  set (sourcenodes as''). V  Def n''"
      by(auto simp:sourcenodes_def)
    with path' Defs' Uses source
    have influence:"nx influences V in n' via (a#as'')"
      by(simp add:dyn_data_dependence_def)
    hence "nx  set (sourcenodes as'')" by(rule dyn_influence_source_notin_tl_edges)
    with influence source
    have "asx a'. sourcenode a' -{V}a'#asxdd n'  sourcenode a' = nx 
          (asx'. a#as'' = asx'@a'#asx)"
      by(fastforce intro:DynPDG_ddep_edge)
    with nodes no_dep as have False by(auto simp:sourcenodes_def) }
  hence "n  set (sourcenodes as). V  Def n" by auto
  with wf path preds show ?thesis by(fastforce intro:CFG_path_no_Def_equal)
qed


lemma DynPDG_ddep_edge_only_first_edge:
  "n -{V}a#asdd n'; preds (kinds (a#as)) s  
    state_val (transfers (kinds (a#as)) s) V = state_val (transfer (kind a) s) V"
  apply -
  apply(erule DynPDG_edge.cases)
  apply auto
  apply(frule dyn_influence_Cons_source)
  apply(frule dyn_influence_source_notin_tl_edges)
  by(erule dyn_influence_only_first_edge)


lemma Use_value_change_implies_DynPDG_ddep_edge:
  assumes "n -as→* n'" and "V  Use n'" and "preds (kinds as) s" 
  and "preds (kinds as) s'" and "state_val s V = state_val s' V"
  and "state_val (transfers (kinds as) s) V  
             state_val (transfers (kinds as) s') V"
  obtains as' a as'' where "as = as'@a#as''"
  and "sourcenode a -{V}a#as''dd n'"
  and "state_val (transfers (kinds as) s) V = 
       state_val (transfers (kinds (as'@[a])) s) V"
  and "state_val (transfers (kinds as) s') V = 
       state_val (transfers (kinds (as'@[a])) s') V"
proof(atomize_elim)
  show "as' a as''. as = as'@a#as'' 
                     sourcenode a -{V}a#as''dd n' 
             state_val (transfers (kinds as) s) V = 
             state_val (transfers (kinds (as'@[a])) s) V 
             state_val (transfers (kinds as) s') V = 
             state_val (transfers (kinds (as'@[a])) s') V"
  proof(cases "as' a as''. as = as'@a#as'' 
                 ¬ sourcenode a -{V}a#as''dd n'")
    case True
    with n -as→* n' V  Use n' ‹preds (kinds as) s ‹preds (kinds as) s'
    have "state_val (transfers (kinds as) s) V = state_val s V"
      and "state_val (transfers (kinds as) s') V = state_val s' V"
      by(auto intro:no_ddep_same_state)
    with state_val s V = state_val s' V 
      state_val (transfers (kinds as) s) V  state_val (transfers (kinds as) s') V
    show ?thesis by simp
  next
    case False
    then obtain as' a as'' where [simp]:"as = as'@a#as''"
      and "sourcenode a -{V}a#as''dd n'" by auto
    from ‹preds (kinds as) s have "preds (kinds (a#as'')) (transfers (kinds as') s)"
      by(simp add:kinds_def preds_split)
    with sourcenode a -{V}a#as''dd n' have all:
      "state_val (transfers (kinds (a#as'')) (transfers (kinds as') s)) V = 
       state_val (transfer (kind a) (transfers (kinds as') s)) V"
      by(auto dest!:DynPDG_ddep_edge_only_first_edge)
    from ‹preds (kinds as) s' 
    have "preds (kinds (a#as'')) (transfers (kinds as') s')"
      by(simp add:kinds_def preds_split)
    with sourcenode a -{V}a#as''dd n' have all':
      "state_val (transfers (kinds (a#as'')) (transfers (kinds as') s')) V = 
       state_val (transfer (kind a) (transfers (kinds as') s')) V"
      by(auto dest!:DynPDG_ddep_edge_only_first_edge)
    hence eq:"s. transfers (kinds as) s =
      transfers (kinds (a#as'')) (transfers (kinds as') s)"
      by(simp add:transfers_split[THEN sym] kinds_def)
    with all have "state_val (transfers (kinds as) s) V = 
                   state_val (transfers (kinds (as'@[a])) s) V"
      by(simp add:transfers_split kinds_def)
    moreover
    from eq all' have "state_val (transfers (kinds as) s') V = 
                       state_val (transfers (kinds (as'@[a])) s') V"
      by(simp add:transfers_split kinds_def)
    ultimately show ?thesis using sourcenode a -{V}a#as''dd n' by simp blast
  qed
qed


end


subsection ‹Instantiate dynamic PDG›

subsubsection ‹Standard control dependence›

locale DynStandardControlDependencePDG =
  Postdomination sourcenode targetnode kind valid_edge Entry Exit +
  CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')")

begin

lemma DynPDG_scd:
  "DynPDG sourcenode targetnode kind valid_edge (_Entry_) 
          Def Use state_val (_Exit_) dyn_standard_control_dependence"
proof(unfold_locales)
  fix n n' as assume "n controlss n' via as"
  show "n'  (_Exit_)"
  proof
    assume "n' = (_Exit_)"
    with n controlss n' via as show False
      by(fastforce intro:Exit_not_dyn_standard_control_dependent)
  qed
next
  fix n n' as assume "n controlss n' via as"
  thus "n -as→* n'  as  []"
    by(fastforce simp:dyn_standard_control_dependence_def)
qed


end

subsubsection ‹Weak control dependence›

locale DynWeakControlDependencePDG = 
  StrongPostdomination sourcenode targetnode kind valid_edge Entry Exit +
  CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')")

begin

lemma DynPDG_wcd:
  "DynPDG sourcenode targetnode kind valid_edge (_Entry_) 
          Def Use state_val (_Exit_) dyn_weak_control_dependence"
proof(unfold_locales)
  fix n n' as assume "n weakly controls n' via as"
  show "n'  (_Exit_)"
  proof
    assume "n' = (_Exit_)"
    with n weakly controls n' via as show False
      by(fastforce intro:Exit_not_dyn_weak_control_dependent)
  qed
next
  fix n n' as assume "n weakly controls n' via as"
  thus "n -as→* n'  as  []"
    by(fastforce simp:dyn_weak_control_dependence_def)
qed


end


subsection ‹Data slice›

definition (in CFG) empty_control_dependence :: "'node  'node  'edge list  bool"
where "empty_control_dependence n n' as  False"

lemma (in CFGExit_wf) DynPDG_scd:
  "DynPDG sourcenode targetnode kind valid_edge (_Entry_)
          Def Use state_val  (_Exit_) empty_control_dependence"
proof(unfold_locales)
  fix n n' as assume "empty_control_dependence n n' as"
  thus "n'  (_Exit_)" by(simp add:empty_control_dependence_def)
next
  fix n n' as assume "empty_control_dependence n n' as"
  thus "n -as→* n'  as  []" by(simp add:empty_control_dependence_def)
qed

end

Theory DependentLiveVariables

section ‹Dependent Live Variables›

theory DependentLiveVariables imports DynPDG begin

text dependent_live_vars› calculates variables which
  can change\\ the value of the @{term Use} variables of the target node›

context DynPDG begin

inductive_set
  dependent_live_vars :: "'node  ('var × 'edge list × 'edge list) set"
  for n' :: "'node"
  where dep_vars_Use: 
  "V  Use n'  (V,[],[])  dependent_live_vars n'"

  | dep_vars_Cons_cdep:
  "V  Use (sourcenode a); sourcenode a -a#as'cd n''; n'' -as''d* n'
   (V,[],a#as'@as'')  dependent_live_vars n'"

  | dep_vars_Cons_ddep:
  "(V,as',as)  dependent_live_vars n'; V'  Use (sourcenode a);
    n' = last(targetnodes (a#as));
    sourcenode a -{V}a#as'dd last(targetnodes (a#as'))
   (V',[],a#as)  dependent_live_vars n'"

  | dep_vars_Cons_keep:
  "(V,as',as)  dependent_live_vars n'; n' = last(targetnodes (a#as));
     ¬ sourcenode a -{V}a#as'dd last(targetnodes (a#as'))
   (V,a#as',a#as)  dependent_live_vars n'"



lemma dependent_live_vars_fst_prefix_snd:
  "(V,as',as)  dependent_live_vars n'  as''. as'@as'' = as"
by(induct rule:dependent_live_vars.induct,simp_all)


lemma dependent_live_vars_Exit_empty [dest]:
  "(V,as',as)  dependent_live_vars (_Exit_)  False"
proof(induct rule:dependent_live_vars.induct)
  case (dep_vars_Cons_cdep V a as' n'' as'')
  from n'' -as''d* (_Exit_) have "n'' = (_Exit_)"
    by(fastforce intro:DynPDG_path_Exit)
  with sourcenode a -a#as'cd n'' have "sourcenode a -a#as'd* (_Exit_)"
    by(fastforce intro:DynPDG_path_cdep)
  hence "sourcenode a = (_Exit_)" by(fastforce intro:DynPDG_path_Exit)
  with V  Use (sourcenode a) show False by simp(erule Exit_Use_empty)
qed auto


lemma dependent_live_vars_lastnode:
  "(V,as',as)  dependent_live_vars n'; as  [] 
   n' = last(targetnodes as)"
proof(induct rule:dependent_live_vars.induct)
  case (dep_vars_Cons_cdep V a as' n'' as'')
  from sourcenode a -a#as'cd n'' have "sourcenode a -a#as'→* n''"
    by(rule DynPDG_cdep_edge_CFG_path(1))
  from n'' -as''d* n' have "n'' -as''→* n'" by(rule DynPDG_path_CFG_path)
  show ?case
  proof(cases "as'' = []")
    case True
    with n'' -as''→* n' have "n'' = n'" by (auto elim: DynPDG.dependent_live_vars.cases)
    with sourcenode a -a#as'→* n'' True
    show ?thesis by(fastforce intro:path_targetnode[THEN sym])
  next
    case False
    with n'' -as''→* n' have "n' = last(targetnodes as'')"
      by(fastforce intro:path_targetnode[THEN sym])
    with False show ?thesis by(fastforce simp:targetnodes_def)
  qed
qed simp_all


lemma dependent_live_vars_Use_cases:
  "(V,as',as)  dependent_live_vars n'; n -as→* n'
   nx as''. as = as'@as''  n -as'→* nx  nx -as''d* n'  V  Use nx  
               (n''  set (sourcenodes as'). V  Def n'')"
proof(induct arbitrary:n rule:dependent_live_vars.induct)
  case (dep_vars_Use V)
  from n -[]→* n' have "valid_node n'" by(rule path_valid_node(2))
  hence "n' -[]d* n'" by(rule DynPDG_path_Nil)
  with V  Use n' n -[]→* n' show ?case 
    by(auto simp:sourcenodes_def)
next
  case (dep_vars_Cons_cdep V a as' n'' as'' n)
  from n -a#as'@as''→* n' have "sourcenode a = n"
    by(auto elim:path.cases)
  from sourcenode a -a#as'cd n'' have "sourcenode a -a#as'→* n''"
    by(rule DynPDG_cdep_edge_CFG_path(1))
  hence "valid_edge a" by(auto elim:path.cases) 
  hence "sourcenode a -[]→* sourcenode a" by(fastforce intro:empty_path)
  from sourcenode a -a#as'cd n'' have "sourcenode a -a#as'd* n''"
    by(rule DynPDG_path_cdep)
  with n'' -as''d* n' have "sourcenode a -(a#as')@as''d* n'"
    by(rule DynPDG_path_Append)
  with sourcenode a -[]→* sourcenode a V  Use (sourcenode a) sourcenode a = n
  show ?case by(auto simp:sourcenodes_def)
next
  case(dep_vars_Cons_ddep V as' as V' a n)
  note ddep = sourcenode a -{V}a#as'dd last (targetnodes (a#as'))
  note IH = n. n -as→* n'
     nx as''. as = as'@as''  n -as'→* nx  nx -as''d* n'  
                   V  Use nx  (n''set (sourcenodes as'). V  Def n'')
  from n -a#as→* n' have "n -[]@a#as→* n'" by simp
  hence "n = sourcenode a" and "targetnode a -as→* n'" and "valid_edge a"
    by(fastforce dest:path_split)+
  hence "n -[]→* n" 
    by(fastforce intro:empty_path simp:valid_node_def)
  from IH[OF targetnode a -as→* n']
  have "nx as''. as = as'@as''  targetnode a -as'→* nx  nx -as''d* n'  
                  V  Use nx  (n''set (sourcenodes as'). V  Def n'')" .
  then obtain nx'' as'' where "targetnode a -as'→* nx''"
    and "nx'' -as''d* n'" and "as = as'@as''" by blast
  have "last (targetnodes (a#as')) -as''d* n'"
  proof(cases as')
    case Nil
    with targetnode a -as'→* nx'' have "nx'' = targetnode a"
      by(auto elim:path.cases)
    with nx'' -as''d* n' Nil show ?thesis by(simp add:targetnodes_def)
  next
    case (Cons ax asx)
    hence "last (targetnodes (a#as')) = last (targetnodes as')"
      by(simp add:targetnodes_def)
    from Cons targetnode a -as'→* nx'' have "last (targetnodes as') = nx''"
      by(fastforce intro:path_targetnode)
    with ‹last (targetnodes (a#as')) = last (targetnodes as') nx'' -as''d* n'
    show ?thesis by simp
  qed
  with ddep as = as'@as'' have "sourcenode a -a#asd* n'"
    by(fastforce dest:DynPDG_path_ddep DynPDG_path_Append)
  with V'  Use (sourcenode a) n = sourcenode a n -[]→* n
  show ?case by(auto simp:sourcenodes_def)
next
  case (dep_vars_Cons_keep V as' as a n)
  note no_dep = ¬ sourcenode a -{V}a#as'dd last (targetnodes (a#as'))
  note IH = n. n -as→* n'
     nx as''. (as = as'@as'')  (n -as'→* nx)  (nx -as''d* n')  
                   V  Use nx  (n''set (sourcenodes as'). V  Def n'')
  from n -a#as→* n' have "n = sourcenode a" and "valid_edge a"
    and "targetnode a -as→* n'" by(auto elim:path_split_Cons)
  from IH[OF targetnode a -as→* n']
  have "nx as''. as = as'@as''  targetnode a -as'→* nx  nx -as''d* n'  
               V  Use nx  (n''set (sourcenodes as'). V  Def n'')" .
  then obtain nx'' as'' where "V  Use nx''"
    and "n''set (sourcenodes as'). V  Def n''" and "targetnode a -as'→* nx''"
    and "nx'' -as''d* n'" and "as = as'@as''" by blast
  from valid_edge a targetnode a -as'→* nx'' have "sourcenode a -a#as'→* nx''"
    by(fastforce intro:Cons_path)
  hence "last(targetnodes (a#as')) = nx''" by(fastforce dest:path_targetnode)
  { assume "V  Def (sourcenode a)"
    with V  Use nx'' sourcenode a -a#as'→* nx''
      n''set (sourcenodes as'). V  Def n'' 
    have "(sourcenode a) influences V in nx'' via a#as'"
      by(simp add:dyn_data_dependence_def sourcenodes_def)
    with no_dep ‹last(targetnodes (a#as')) = nx''
      n''set (sourcenodes as'). V  Def n'' V  Def (sourcenode a)
    have False by(fastforce dest:DynPDG_ddep_edge) }
  with n''set (sourcenodes as'). V  Def n'' 
  have "n''set (sourcenodes (a#as')). V  Def n''"
    by(fastforce simp:sourcenodes_def)
  with V  Use nx'' sourcenode a -a#as'→* nx'' nx'' -as''d* n'
    as = as'@as'' n = sourcenode a show ?case by fastforce
qed


lemma dependent_live_vars_dependent_edge:
  assumes "(V,as',as)  dependent_live_vars n'" 
  and "targetnode a -as→* n'"
  and "V  Def (sourcenode a)" and "valid_edge a"
  obtains nx as'' where "as = as'@as''" and "sourcenode a -{V}a#as'dd nx"
  and "nx -as''d* n'"
proof(atomize_elim)
  from (V,as',as)  dependent_live_vars n' targetnode a -as→* n'
  have "nx as''. as = as'@as''  targetnode a -as'→* nx  nx -as''d* n'  
    V  Use nx  (n''  set (sourcenodes as'). V  Def n'')"
    by(rule dependent_live_vars_Use_cases)
  then obtain nx as'' where "V  Use nx"
    and "n'' set(sourcenodes as'). V  Def n''"
    and "targetnode a -as'→* nx" and "nx -as''d* n'"
    and "as = as'@as''" by blast
  from targetnode a -as'→* nx valid_edge a have "sourcenode a -a#as'→* nx"
    by(fastforce intro:Cons_path)
  with V  Def (sourcenode a) V  Use nx 
    n'' set(sourcenodes as'). V  Def n'' 
  have "sourcenode a influences V in nx via a#as'"
    by(auto simp:dyn_data_dependence_def sourcenodes_def)
  hence "sourcenode a -{V}a#as'dd nx" by(rule DynPDG_ddep_edge)
  with nx -as''d* n' as = as'@as'' 
  show "as'' nx. (as = as'@as'')  (sourcenode a -{V}a#as'dd nx)  
    (nx -as''d* n')" by fastforce
qed



lemma dependent_live_vars_same_pathsI:
  assumes "V  Use n'"
  shows "as' a as''. as = as'@a#as''  ¬ sourcenode a -{V}a#as''dd n'; 
          as  []  n' = last(targetnodes as)
   (V,as,as)  dependent_live_vars n'"
proof(induct as)
  case Nil
  from V  Use n' show ?case by(rule dep_vars_Use)
next
  case (Cons ax asx)
  note lastnode = ax#asx  []  n' = last (targetnodes (ax#asx))
  note IH = as' a as''. asx = as'@a#as'' 
                           ¬ sourcenode a -{V}a#as''dd n';
             asx  []  n' = last (targetnodes asx)
            (V, asx, asx)  dependent_live_vars n'
  from as' a as''. ax#asx = as'@a#as''  ¬ sourcenode a -{V}a#as''dd n'
  have all':"as' a as''. asx = as'@a#as''  ¬ sourcenode a -{V}a#as''dd n'"
    and "¬ sourcenode ax -{V}ax#asxdd n'"
    by simp_all
  show ?case
  proof(cases "asx = []")
    case True
    from V  Use n' have "(V,[],[])  dependent_live_vars n'" by(rule dep_vars_Use)
    with ¬ sourcenode ax -{V}ax#asxdd n' True lastnode
    have "(V,[ax],[ax])  dependent_live_vars n'"
      by(fastforce intro:dep_vars_Cons_keep)
    with True show ?thesis by simp
  next
    case False
    with lastnode have "asx  []  n' = last (targetnodes asx)"
      by(simp add:targetnodes_def)
    from IH[OF all' this] have "(V, asx, asx)  dependent_live_vars n'" .
    with ¬ sourcenode ax -{V}ax#asxdd n' lastnode 
    show ?thesis by(fastforce intro:dep_vars_Cons_keep)
  qed
qed


lemma dependent_live_vars_same_pathsD:
  "(V,as,as)  dependent_live_vars n';  as  []  n' = last(targetnodes as)
   V  Use n'  (as' a as''. as = as'@a#as'' 
                       ¬ sourcenode a -{V}a#as''dd n')"
proof(induct as)
  case Nil
  have "(V,[],[])  dependent_live_vars n'" by fact
  thus ?case
    by(fastforce elim:dependent_live_vars.cases simp:targetnodes_def sourcenodes_def)
next
  case (Cons ax asx)
  note IH = (V,asx,asx)  dependent_live_vars n'; 
              asx  []  n' = last (targetnodes asx)
     V  Use n'  (as' a as''. asx = as'@a#as'' 
                          ¬ sourcenode a -{V}a#as''dd n')
  from (V,ax#asx,ax#asx)  dependent_live_vars n'
  have "(V,asx,asx)  dependent_live_vars n'"
    and "¬ sourcenode ax -{V}ax#asxdd last(targetnodes (ax#asx))"
    by(auto elim:dependent_live_vars.cases)
  from ax#asx  []  n' = last (targetnodes (ax#asx))
  have "n' = last (targetnodes (ax#asx))" by simp
  show ?case
  proof(cases "asx = []")
    case True
    with (V,asx,asx)  dependent_live_vars n' have "V  Use n'"
      by(fastforce elim:dependent_live_vars.cases)
    from ¬ sourcenode ax -{V}ax#asxdd last(targetnodes (ax#asx)) 
      True n' = last (targetnodes (ax#asx))
    have "as' a as''. ax#asx = as'@a#as''  ¬ sourcenode a -{V}a#as''dd n'"
      by auto(case_tac as',auto)
    with V  Use n' show ?thesis by simp
  next
    case False
    with n' = last (targetnodes (ax#asx))
    have "asx  []  n' = last (targetnodes asx)"
      by(simp add:targetnodes_def)
    from IH[OF (V,asx,asx)  dependent_live_vars n' this] 
    have "V  Use n'  (as' a as''. asx = as'@a#as'' 
                            ¬ sourcenode a -{V}a#as''dd n')" .
    with ¬ sourcenode ax -{V}ax#asxdd last(targetnodes (ax#asx))
      n' = last (targetnodes (ax#asx)) have "V  Use n'"
      and "as' a as''. ax#asx = as'@a#as'' 
                            ¬ sourcenode a -{V}a#as''dd n'"
      by auto(case_tac as',auto)
    thus ?thesis by simp
  qed
qed


lemma dependent_live_vars_same_paths:
  "as  []  n' = last(targetnodes as) 
  (V,as,as)  dependent_live_vars n' = 
  (V  Use n'  (as' a as''. as = as'@a#as'' 
                       ¬ sourcenode a -{V}a#as''dd n'))"
by(fastforce intro!:dependent_live_vars_same_pathsD dependent_live_vars_same_pathsI)


lemma dependent_live_vars_cdep_empty_fst:
assumes "n'' -ascd n'" and "V'  Use n''"
  shows "(V',[],as)  dependent_live_vars n'"
proof(cases as)
  case Nil
  with n'' -ascd n' show ?thesis
    by(fastforce elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
next
  case (Cons ax asx)
  with n'' -ascd n' have "sourcenode ax = n''"
    by(auto dest:DynPDG_cdep_edge_CFG_path elim:path.cases)
  from n'' -ascd n' have "valid_node n'"
    by(fastforce intro:path_valid_node(2) DynPDG_cdep_edge_CFG_path(1))
  from Cons n'' -ascd n' have "last(targetnodes as) = n'"
    by(fastforce intro:path_targetnode dest:DynPDG_cdep_edge_CFG_path)
  with Cons n'' -ascd n' V'  Use n'' sourcenode ax = n'' ‹valid_node n'
  have "(V', [], ax#asx@[])  dependent_live_vars n'"
    by(fastforce intro:dep_vars_Cons_cdep DynPDG_path_Nil)
  with Cons show ?thesis by simp
qed
  

lemma dependent_live_vars_ddep_empty_fst:
  assumes "n'' -{V}asdd n'" and "V'  Use n''"
  shows "(V',[],as)  dependent_live_vars n'"
proof(cases as)
  case Nil
  with n'' -{V}asdd n' show ?thesis
    by(fastforce elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
next
  case (Cons ax asx)
  with n'' -{V}asdd n' have "sourcenode ax = n''"
    by(auto dest:DynPDG_ddep_edge_CFG_path elim:path.cases)
  from Cons n'' -{V}asdd n' have "last(targetnodes as) = n'"
    by(fastforce intro:path_targetnode elim:DynPDG_ddep_edge_CFG_path(1))
  from Cons n'' -{V}asdd n' have all:"as' a as''. asx = as'@a#as'' 
                             ¬ sourcenode a -{V}a#as''dd n'"
    by(fastforce dest:DynPDG_ddep_edge_no_shorter_ddep_edge)
  from n'' -{V}asdd n' have "V  Use n'" 
    by(auto elim!:DynPDG_edge.cases simp:dyn_data_dependence_def)
  from Cons n'' -{V}asdd n' have "as  []  n' = last(targetnodes as)"
    by(fastforce dest:DynPDG_ddep_edge_CFG_path path_targetnode)
  with Cons have "asx  []  n' = last(targetnodes asx)"
    by(fastforce simp:targetnodes_def)
  with all V  Use n' have "(V,asx,asx)  dependent_live_vars n'"
    by -(rule dependent_live_vars_same_pathsI)
  with V'  Use n'' n'' -{V}asdd n' ‹last(targetnodes as) = n'
    Cons sourcenode ax = n'' show ?thesis
    by(fastforce intro:dep_vars_Cons_ddep)
qed




lemma ddep_dependent_live_vars_keep_notempty:
  assumes "n -{V}a#asdd n''" and "as'  []"
  and "(V,as'',as')  dependent_live_vars n'"
  shows "(V,as@as'',as@as')  dependent_live_vars n'"
proof -
  from n -{V}a#asdd n'' have "n''  set (sourcenodes as). V  Def n''"
    by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
  with (V,as'',as')  dependent_live_vars n' show ?thesis
  proof(induct as)
    case Nil thus ?case by simp
  next
    case (Cons ax asx)
    note IH = (V,as'',as')  dependent_live_vars n';
                n''set (sourcenodes asx). V  Def n''
                (V, asx@as'',asx@as')  dependent_live_vars n'
    from n''set (sourcenodes (ax#asx)). V  Def n''
    have "n''set (sourcenodes asx). V  Def n''"
      by(auto simp:sourcenodes_def)
    from IH[OF (V,as'',as')  dependent_live_vars n' this]
    have "(V,asx@as'',asx@as')  dependent_live_vars n'" .
    from as'  [] (V,as'',as')  dependent_live_vars n'
    have "n' = last(targetnodes as')" 
      by(fastforce intro:dependent_live_vars_lastnode)
    with as'  [] have "n' = last(targetnodes (ax#asx@as'))"
      by(fastforce simp:targetnodes_def)
    have "¬ sourcenode ax -{V}ax#asx@as''dd last(targetnodes (ax#asx@as''))"
    proof
      assume "sourcenode ax -{V}ax#asx@as''dd last(targetnodes (ax#asx@as''))"
      hence "sourcenode ax -{V}ax#asx@as''dd last(targetnodes (ax#asx@as''))"
        by simp
      with n''set (sourcenodes (ax#asx)). V  Def n''
      show False
        by(fastforce elim:DynPDG_edge.cases 
                    simp:dyn_data_dependence_def sourcenodes_def)
    qed
    with (V,asx@as'',asx@as')  dependent_live_vars n' 
      n' = last(targetnodes (ax#asx@as'))
    show ?case by(fastforce intro:dep_vars_Cons_keep)
  qed
qed



lemma dependent_live_vars_cdep_dependent_live_vars:
  assumes "n'' -as''cd n'" and "(V',as',as)  dependent_live_vars n''"
  shows "(V',as',as@as'')  dependent_live_vars n'"
proof -
  from n'' -as''cd n' have "as''  []"
    by(fastforce elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
  with n'' -as''cd n' have "last(targetnodes as'') = n'"
    by(fastforce intro:path_targetnode elim:DynPDG_cdep_edge_CFG_path(1))
  from (V',as',as)  dependent_live_vars n'' show ?thesis
  proof(induct rule:dependent_live_vars.induct)
    case (dep_vars_Use V')
    from V'  Use n'' n'' -as''cd n' ‹last(targetnodes as'') = n' show ?case
      by(fastforce intro:dependent_live_vars_cdep_empty_fst simp:targetnodes_def)
  next
    case (dep_vars_Cons_cdep V a as' nx asx)
    from n'' -as''cd n' have "n'' -as''d* n'" by(rule DynPDG_path_cdep)
    with nx -asxd* n'' have "nx -asx@as''d* n'"
      by -(rule DynPDG_path_Append)
    with V  Use (sourcenode a) (sourcenode a) -a#as'cd nx
    show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_cdep)
  next
    case (dep_vars_Cons_ddep V as' as V' a)
    from as''  [] ‹last(targetnodes as'') = n'
    have "n' = last(targetnodes ((a#as)@as''))"
      by(simp add:targetnodes_def)
    with dep_vars_Cons_ddep
    show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_ddep)
  next
    case (dep_vars_Cons_keep V as' as a)
    from as''  [] ‹last(targetnodes as'') = n'
    have "n' = last(targetnodes ((a#as)@as''))"
      by(simp add:targetnodes_def)
    with dep_vars_Cons_keep
    show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_keep)
  qed
qed


lemma dependent_live_vars_ddep_dependent_live_vars:
  assumes "n'' -{V}as''dd n'" and "(V',as',as)  dependent_live_vars n''"
  shows "(V',as',as@as'')  dependent_live_vars n'"
proof -
  from n'' -{V}as''dd n' have "as''  []"
    by(rule DynPDG_ddep_edge_CFG_path(2))
  with n'' -{V}as''dd n' have "last(targetnodes as'') = n'"
    by(fastforce intro:path_targetnode elim:DynPDG_ddep_edge_CFG_path(1))
  from n'' -{V}as''dd n' have notExit:"n'  (_Exit_)" 
    by(fastforce elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
  from (V',as',as)  dependent_live_vars n'' show ?thesis
  proof(induct rule:dependent_live_vars.induct)
    case (dep_vars_Use V')
    from V'  Use n'' n'' -{V}as''dd n' ‹last(targetnodes as'') = n' show ?case
      by(fastforce intro:dependent_live_vars_ddep_empty_fst simp:targetnodes_def)
  next
    case (dep_vars_Cons_cdep V' a as' nx asx)
    from n'' -{V}as''dd n' have "n'' -as''d* n'" by(rule DynPDG_path_ddep)
    with nx -asxd* n'' have "nx -asx@as''d* n'"
      by -(rule DynPDG_path_Append)
    with V'  Use (sourcenode a) sourcenode a -a#as'cd nx notExit
    show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_cdep)
  next
    case (dep_vars_Cons_ddep V as' as V' a)
    from as''  [] ‹last(targetnodes as'') = n'
    have "n' = last(targetnodes ((a#as)@as''))"
      by(simp add:targetnodes_def)
    with dep_vars_Cons_ddep
    show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_ddep)
  next
    case (dep_vars_Cons_keep V as' as a)
    from as''  [] ‹last(targetnodes as'') = n'
    have "n' = last(targetnodes ((a#as)@as''))"
      by(simp add:targetnodes_def)
    with dep_vars_Cons_keep
    show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_keep)
  qed
qed


lemma dependent_live_vars_dep_dependent_live_vars:
  "n'' -as''d* n'; (V',as',as)  dependent_live_vars n''
   (V',as',as@as'')  dependent_live_vars n'"
proof(induct rule:DynPDG_path.induct)
  case (DynPDG_path_Nil n) thus ?case by simp
next
  case (DynPDG_path_Append_cdep n asx n'' asx' n')
  note IH = (V', as', as)  dependent_live_vars n 
             (V', as', as @ asx)  dependent_live_vars n''
  from IH[OF (V',as',as)  dependent_live_vars n]
  have "(V',as',as@asx)  dependent_live_vars n''" .
  with n'' -asx'cd n' have "(V',as',(as@asx)@asx')  dependent_live_vars n'"
    by(rule dependent_live_vars_cdep_dependent_live_vars)
  thus ?case by simp
next
  case (DynPDG_path_Append_ddep n asx n'' V asx' n')
  note IH = (V', as', as)  dependent_live_vars n 
             (V', as', as @ asx)  dependent_live_vars n''
  from IH[OF (V',as',as)  dependent_live_vars n]
  have "(V',as',as@asx)  dependent_live_vars n''" .
  with n'' -{V}asx'dd n' have "(V',as',(as@asx)@asx')  dependent_live_vars n'"
    by(rule dependent_live_vars_ddep_dependent_live_vars)
  thus ?case by simp
qed

end


end

Theory BitVector

section ‹Formalization of Bit Vectors›

theory BitVector imports Main begin

type_synonym bit_vector = "bool list"

fun bv_leqs :: "bit_vector  bit_vector  bool" ("_ b _" 99)
  where bv_Nils:"[] b [] = True"
  | bv_Cons:"(x#xs) b (y#ys) = ((x  y)  xs b ys)"
  | bv_rest:"xs b ys = False"


subsection ‹Some basic properties›

lemma bv_length: "xs b ys  length xs = length ys"
by(induct rule:bv_leqs.induct)auto


lemma [dest!]: "xs b []  xs = []"
by(induct xs) auto


lemma bv_leqs_AppendI:
  "xs b ys; xs' b ys'  (xs@xs') b (ys@ys')"
by(induct xs ys rule:bv_leqs.induct,auto)


lemma bv_leqs_AppendD:
  "(xs@xs') b (ys@ys'); length xs = length ys
   xs b ys  xs' b ys'"
by(induct xs ys rule:bv_leqs.induct,auto)


lemma bv_leqs_eq:
  "xs b ys = ((i < length xs. xs ! i  ys ! i)  length xs = length ys)"
proof(induct xs ys rule:bv_leqs.induct)
  case (2 x xs y ys)
  note eq = xs b ys = 
    ((i < length xs. xs ! i  ys ! i)  length xs = length ys)
  show ?case
  proof
    assume leqs:"x#xs b y#ys"
    with eq have "x  y" and "i < length xs. xs ! i  ys ! i"
      and "length xs = length ys" by simp_all
    from x  y have "(x#xs) ! 0  (y#ys) ! 0" by simp
    { fix i assume "i > 0" and "i < length (x#xs)"
      then obtain j where "i = Suc j" and "j < length xs" by(cases i) auto
      with i < length xs. xs ! i  ys ! i 
      have "(x#xs) ! i  (y#ys) ! i" by auto }
    hence "i < length (x#xs). i > 0  (x#xs) ! i  (y#ys) ! i" by simp
    with (x#xs) ! 0  (y#ys) ! 0 ‹length xs = length ys
    show "(i < length (x#xs). (x#xs) ! i  (y#ys) ! i)  
      length (x#xs) = length (y#ys)"
      by clarsimp(case_tac "i>0",auto)
  next
    assume "(i < length (x#xs). (x#xs) ! i  (y#ys) ! i)  
      length (x#xs) = length (y#ys)"
    hence "i < length (x#xs). (x#xs) ! i  (y#ys) ! i" 
      and "length (x#xs) = length (y#ys)" by simp_all
    from i < length (x#xs). (x#xs) ! i  (y#ys) ! i
    have "i < length xs. xs ! i  ys ! i"
      by clarsimp(erule_tac x="Suc i" in allE,auto)
    with eq ‹length (x#xs) = length (y#ys) have "xs b ys" by simp
    from i < length (x#xs). (x#xs) ! i  (y#ys) ! i
    have "x  y" by(erule_tac x="0" in allE) simp
    with xs b ys show "x#xs b y#ys" by simp
  qed
qed simp_all


subsection ‹$\preceq_b$ is an order on bit vectors with minimal and 
  maximal element›

lemma minimal_element:
  "replicate (length xs) False b xs"
by(induct xs) auto

lemma maximal_element:
  "xs b replicate (length xs) True"
by(induct xs) auto

lemma bv_leqs_refl:"xs b xs"
  by(induct xs) auto


lemma bv_leqs_trans:"xs b ys; ys b zs  xs b zs"
proof(induct xs ys arbitrary:zs rule:bv_leqs.induct)
  case (2 x xs y ys)
  note IH = zs. xs b ys; ys b zs  xs b zs
  from (x#xs) b (y#ys) have "xs b ys" and "x  y" by simp_all
  from (y#ys) b zs obtain z zs' where "zs = z#zs'" by(cases zs) auto
  with (y#ys) b zs have "ys b zs'" and "y  z" by simp_all
  from IH[OF xs b ys ys b zs'] have "xs b zs'" .
  with x  y y  z zs = z#zs' show ?case by simp
qed simp_all


lemma bv_leqs_antisym:"xs b ys; ys b xs  xs = ys"
  by(induct xs ys rule:bv_leqs.induct)auto


definition bv_less :: "bit_vector  bit_vector  bool" ("_ b _" 99)
  where "xs b ys  xs b ys  xs  ys"


interpretation order "bv_leqs" "bv_less"
by(unfold_locales,
   auto intro:bv_leqs_refl bv_leqs_trans bv_leqs_antisym simp:bv_less_def)


end

Theory DynSlice

section ‹Dynamic Backward Slice›

theory DynSlice imports DependentLiveVariables BitVector "../Basic/SemanticsCFG" begin

subsection ‹Backward slice of paths›

context DynPDG begin

fun slice_path :: "'edge list  bit_vector"
  where "slice_path [] = []"
  | "slice_path (a#as) = (let n' = last(targetnodes (a#as)) in
                           (sourcenode a -a#asd* n')#slice_path as)"

(*<*)declare Let_def [simp](*>*)

lemma slice_path_length:
  "length(slice_path as) = length as"
by(induct as) auto


lemma slice_path_right_Cons:
  assumes slice:"slice_path as = x#xs"
  obtains a' as' where "as = a'#as'" and "slice_path as' = xs"
proof(atomize_elim)
  from slice show "a' as'. as = a'#as'  slice_path as' = xs"
    by(induct as) auto
qed


subsection ‹The proof of the fundamental property of (dynamic) slicing›

fun select_edge_kinds :: "'edge list  bit_vector  'state edge_kind list"
where "select_edge_kinds [] [] = []"
  | "select_edge_kinds (a#as) (b#bs) = (if b then kind a
      else (case kind a of f  id | (Q)  (λs. True)))#select_edge_kinds as bs"


definition slice_kinds :: "'edge list  'state edge_kind list"
  where "slice_kinds as = select_edge_kinds as (slice_path as)"


lemma select_edge_kinds_max_bv:
  "select_edge_kinds as (replicate (length as) True) = kinds as"
by(induct as,auto simp:kinds_def)


lemma slice_path_leqs_information_same_Uses:
  "n -as→* n'; bs b bs'; slice_path as = bs;
    select_edge_kinds as bs = es; select_edge_kinds as bs' = es'; 
    V xs. (V,xs,as)  dependent_live_vars n'  state_val s V = state_val s' V;
    preds es' s' 
   (V  Use n'. state_val (transfers es s) V =
      state_val (transfers es' s') V)  preds es s"
proof(induct bs bs' arbitrary:as es es' n s s' rule:bv_leqs.induct)
  case 1
  from ‹slice_path as = [] have "as = []" by(cases as) auto
  with ‹select_edge_kinds as [] = es ‹select_edge_kinds as [] = es'
  have "es = []" and "es' = []" by simp_all
  { fix V assume "V  Use n'"
    hence "(V,[],[])  dependent_live_vars n'" by(rule dep_vars_Use)
    with V xs. (V,xs,as)  dependent_live_vars n' 
                  state_val s V = state_val s' V V  Use n' as = []
    have "state_val s V = state_val s' V" by blast }
  with es = [] es' = [] show ?case by simp
next
  case (2 x xs y ys)
  note all = V xs. (V,xs,as)  dependent_live_vars n' 
                     state_val s V = state_val s' V
  note IH = as es es' n s s'. n -as→* n'; xs b ys; slice_path as = xs; 
                        select_edge_kinds as xs = es; select_edge_kinds as ys = es';
                        V xs. (V,xs,as)  dependent_live_vars n' 
                                   state_val s V = state_val s' V; 
                           preds es' s'
             (V  Use n'. state_val (transfers es s) V =
                state_val (transfers es' s') V)  preds es s
  from x#xs b y#ys have "x  y" and "xs b ys" by simp_all
  from ‹slice_path as = x#xs obtain a' as' where "as = a'#as'"
    and "slice_path as' = xs" by(erule slice_path_right_Cons)
  from as = a'#as' ‹select_edge_kinds as (x#xs) = es
  obtain ex esx where "es = ex#esx"
    and ex:"ex = (if x then kind a'
                    else (case kind a' of f  id | (Q)  (λs. True)))"
    and "select_edge_kinds as' xs = esx" by auto
  from as = a'#as' ‹select_edge_kinds as (y#ys) = es' obtain ex' esx' 
    where "es' = ex'#esx'"
    and ex':"ex' = (if y then kind a'
                    else (case kind a' of f  id | (Q)  (λs. True)))"
    and "select_edge_kinds as' ys = esx'" by auto
  from n -as→* n' as = a'#as' have [simp]:"n = sourcenode a'" 
    and "valid_edge a'" and "targetnode a' -as'→* n'"
    by(auto elim:path_split_Cons)
  from n -as→* n' as = a'#as' have "last(targetnodes as) = n'"
    by(fastforce intro:path_targetnode)
  from ‹preds es' s' es' = ex'#esx' have "pred ex' s'"
    and "preds esx' (transfer ex' s')" by simp_all
  show ?case
  proof(cases "as' = []")
    case True
    hence [simp]:"as' = []" by simp
    with ‹slice_path as' = xs xs b ys 
    have [simp]:"xs = []  ys = []" by auto(cases ys,auto)+
    with ‹select_edge_kinds as' xs = esx ‹select_edge_kinds as' ys = esx'
    have [simp]:"esx = []" and [simp]:"esx' = []" by simp_all
    from True targetnode a' -as'→* n' 
    have [simp]:"n' = targetnode a'" by(auto elim:path.cases)
    show ?thesis
    proof(cases x)
      case True
      with x  y ex ex' have [simp]:"ex = kind a'  ex' = kind a'" by simp
      have "pred ex s"
      proof(cases ex)
        case (Predicate Q)
        with ex ex' True x  y have [simp]:"transfer ex s = s" 
          and [simp]:"transfer ex' s' = s'"
          by(cases "kind a'",auto)+
        show ?thesis
        proof(cases "n -[a']cd n'")
          case True
          { fix V' assume "V'  Use n"
            with True valid_edge a'
            have "(V',[],a'#[]@[])  dependent_live_vars n'"
              by(fastforce intro:dep_vars_Cons_cdep DynPDG_path_Nil 
                          simp:targetnodes_def)
            with all as = a'#as' have "state_val s V' = state_val s' V'"
              by fastforce }
          with ‹pred ex' s' valid_edge a'
          show ?thesis by(fastforce elim:CFG_edge_Uses_pred_equal)
        next
          case False
          from ex True Predicate have "kind a' = (Q)" by(auto split:if_split_asm)
          from True ‹slice_path as = x#xs as = a'#as' have "n -[a']d* n'"
            by(auto simp:targetnodes_def)
          thus ?thesis
          proof(induct rule:DynPDG_path.cases)
            case (DynPDG_path_Nil nx)
            hence False by simp
            thus ?case by simp
          next
            case (DynPDG_path_Append_cdep nx asx n'' asx' nx')
            from [a'] = asx@asx' 
            have "(asx = [a']  asx' = [])  (asx = []  asx' = [a'])"
              by (cases asx) auto
            hence False
            proof
              assume "asx = [a']  asx' = []"
              with n'' -asx'cd nx' show False
                by(fastforce elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
            next
              assume "asx = []  asx' = [a']"
              with nx -asxd* n'' have "nx = n''" and "asx' = [a']"
                by(auto intro:DynPDG_empty_path_eq_nodes)
              with n = nx n' = nx' n'' -asx'cd nx' False
              show False by simp
            qed
            thus ?thesis by simp
          next
            case (DynPDG_path_Append_ddep nx asx n'' V asx' nx')
            from [a'] = asx@asx' 
            have "(asx = [a']  asx' = [])  (asx = []  asx' = [a'])"
              by (cases asx) auto
            thus ?case
            proof
              assume "asx = [a']  asx' = []"
              with n'' -{V}asx'dd nx' have False
                by(fastforce elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
              thus ?thesis by simp
            next
              assume "asx = []  asx' = [a']"
              with nx -asxd* n'' have "nx = n''"
                by(simp add:DynPDG_empty_path_eq_nodes)
              { fix V' assume "V'  Use n"
                from n'' -{V}asx'dd nx' asx = []  asx' = [a'] n' = nx'
                have "(V,[],[])  dependent_live_vars n'"
                  by(fastforce intro:dep_vars_Use elim:DynPDG_edge.cases
                    simp:dyn_data_dependence_def)
                with V'  Use n n'' -{V}asx'dd nx' asx = []  asx' = [a']
                  n = nx nx = n'' n' = nx'
                have "(V',[],[a'])  dependent_live_vars n'"
                  by(auto elim:dep_vars_Cons_ddep simp:targetnodes_def)
                with all as = a'#as' have "state_val s V' = state_val s' V'"
                  by fastforce }
              with ‹pred ex' s' valid_edge a' ex ex' True x  y show ?thesis
                by(fastforce elim:CFG_edge_Uses_pred_equal)
            qed
          qed
        qed
      qed simp
      { fix V assume "V  Use n'"
        from V  Use n' have "(V,[],[])  dependent_live_vars n'" 
          by(rule dep_vars_Use)
        have "state_val (transfer ex s) V = state_val (transfer ex' s') V"
        proof(cases "n -{V}[a']dd n'")
          case True
          hence "V  Def n"
            by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
          have "V. V  Use n  state_val s V = state_val s' V"
          proof -
            fix V' assume "V'  Use n"
            with (V,[],[])  dependent_live_vars n' True
            have "(V',[],[a'])  dependent_live_vars n'"
              by(fastforce intro:dep_vars_Cons_ddep simp:targetnodes_def)
            with all as = a'#as' show "state_val s V' = state_val s' V'" by auto
          qed
          with valid_edge a' ‹pred ex' s' ‹pred ex s
          have "V  Def n. state_val (transfer (kind a') s) V =
                              state_val (transfer (kind a') s') V"
            by simp(rule CFG_edge_transfer_uses_only_Use,auto)
          with V  Def n have "state_val (transfer (kind a') s) V = 
                         state_val (transfer (kind a') s') V"
            by simp
          thus ?thesis by fastforce
        next
          case False
          with ‹last(targetnodes as) = n' as = a'#as'
            (V,[],[])  dependent_live_vars n'
          have "(V,[a'],[a'])  dependent_live_vars n'"
            by(fastforce intro:dep_vars_Cons_keep)
          from (V,[a'],[a'])  dependent_live_vars n' all as = a'#as'
          have states_eq:"state_val s V = state_val s' V"
            by auto
          from valid_edge a' V  Use n' False ‹pred ex s
          have "state_val (transfers (kinds [a']) s) V = state_val s V"
            apply(auto intro!:no_ddep_same_state path_edge simp:targetnodes_def)
            apply(simp add:kinds_def)
            by(case_tac as',auto)
          moreover
          from valid_edge a' V  Use n' False ‹pred ex' s'
          have "state_val (transfers (kinds [a']) s') V = state_val s' V"
            apply(auto intro!:no_ddep_same_state path_edge simp:targetnodes_def)
            apply(simp add:kinds_def)
            by(case_tac as',auto)
          ultimately show ?thesis using states_eq by(auto simp:kinds_def)
        qed }
      hence "V  Use n'. state_val (transfer ex s) V = 
                                state_val (transfer ex' s') V" by simp
      with ‹pred ex s es = ex#esx es' = ex'#esx' show ?thesis by simp
    next
      case False
      with ex have cases_x:"ex = (case kind a' of f  id | (Q)  (λs. True))"
        by simp
      from cases_x have "pred ex s" by(cases "kind a'",auto)
      show ?thesis
      proof(cases y)
        case True
        with ex' have [simp]:"ex' = kind a'" by simp
        { fix V assume "V  Use n'"
          from V  Use n' have "(V,[],[])  dependent_live_vars n'"
            by(rule dep_vars_Use)
          from ‹slice_path as = x#xs as = a'#as' ¬ x 
          have "¬ n -[a']d* n'" by(simp add:targetnodes_def)
          hence "¬ n -{V}[a']dd n'" by(fastforce dest:DynPDG_path_ddep)
          with ‹last(targetnodes as) = n' as = a'#as'
            (V,[],[])  dependent_live_vars n'
          have "(V,[a'],[a'])  dependent_live_vars n'"
            by(fastforce intro:dep_vars_Cons_keep)
          with all as = a'#as' have "state_val s V = state_val s' V" by auto
          from valid_edge a' V  Use n' ‹pred ex' s'
            ¬ n -{V}[a']dd n' ‹last(targetnodes as) = n' as = a'#as'
          have "state_val (transfers (kinds [a']) s') V = state_val s' V"
            apply(auto intro!:no_ddep_same_state path_edge)
            apply(simp add:kinds_def)
            by(case_tac as',auto)
          with state_val s V = state_val s' V cases_x
          have "state_val (transfer ex s) V =
                state_val (transfer ex' s') V"
            by(cases "kind a'",simp_all add:kinds_def) }
        hence "V  Use n'. state_val (transfer ex s) V =
                           state_val (transfer ex' s') V" by simp
        with as = a'#as' es = ex#esx es' = ex'#esx' ‹pred ex s 
        show ?thesis by simp
      next
        case False
        with ex' have cases_y:"ex' = (case kind a' of f  id | (Q)  (λs. True))"
          by simp
        with cases_x have [simp]:"ex = ex'" by(cases "kind a'") auto
        { fix V assume "V  Use n'"
          from V  Use n' have "(V,[],[])  dependent_live_vars n'"
            by(rule dep_vars_Use)
          from ‹slice_path as = x#xs as = a'#as' ¬ x 
          have "¬ n -[a']d* n'" by(simp add:targetnodes_def)
          hence no_dep:"¬ n -{V}[a']dd n'" by(fastforce dest:DynPDG_path_ddep)
          with ‹last(targetnodes as) = n' as = a'#as'
            (V,[],[])  dependent_live_vars n'
          have "(V,[a'],[a'])  dependent_live_vars n'"
            by(fastforce intro:dep_vars_Cons_keep)
          with all as = a'#as' have "state_val s V = state_val s' V" by auto }
        with as = a'#as' cases_x es = ex#esx es' = ex'#esx' ‹pred ex s
        show ?thesis by(cases "kind a'",auto)
      qed
    qed
  next
    case False
    show ?thesis
    proof(cases "V xs. (V,xs,as')  dependent_live_vars n' 
                        state_val (transfer ex s) V = state_val (transfer ex' s') V")
      case True
      hence imp':"V xs. (V,xs,as')  dependent_live_vars n' 
                       state_val (transfer ex s) V = state_val (transfer ex' s') V" .
      from IH[OF targetnode a' -as'→* n' xs b ys ‹slice_path as' = xs
        ‹select_edge_kinds as' xs = esx ‹select_edge_kinds as' ys = esx' 
        this ‹preds esx' (transfer ex' s')]
      have all':"VUse n'. state_val (transfers esx (transfer ex s)) V =
                             state_val (transfers esx' (transfer ex' s')) V"
        and "preds esx (transfer ex s)" by simp_all
      have "pred ex s"
      proof(cases ex)
        case (Predicate Q)
        with ‹slice_path as = x#xs as = a'#as' ‹last(targetnodes as) = n' ex 
        have "ex = (λs. True)  n -a'#as'd* n'"
          by(cases "kind a'",auto split:if_split_asm) 
        thus ?thesis
        proof
          assume "ex = (λs. True)" thus ?thesis by simp
        next
          assume "n -a'#as'd* n'"
          with ‹slice_path as = x#xs as = a'#as' ‹last(targetnodes as) = n' ex
          have [simp]:"ex = kind a'" by clarsimp
          with x  y ex ex' have [simp]:"ex' = ex" by(cases x) auto
          from n -a'#as'd* n' show ?thesis
          proof(induct rule:DynPDG_path_rev_cases)
            case DynPDG_path_Nil
            hence False by simp
            thus ?thesis by simp
          next
            case (DynPDG_path_cdep_Append n'' asx asx')
            from n -asxcd n''have "asx  []"
              by(auto elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
            with n -asxcd n'' n'' -asx'd* n' a'#as' = asx@asx'
            have cdep:"as1 as2 n''. n -a'#as1cd n''  
                                     n'' -as2d* n'  as' = as1@as2"
              by(cases asx) auto 
            { fix V assume "V  Use n"
              with cdep ‹last(targetnodes as) = n' as = a'#as'
              have "(V,[],as)  dependent_live_vars n'"
                by(fastforce intro:dep_vars_Cons_cdep)
              with all have "state_val s V = state_val s' V" by blast }
            with valid_edge a' ‹pred ex' s'
            show ?thesis by(fastforce elim:CFG_edge_Uses_pred_equal)
          next
            case (DynPDG_path_ddep_Append V n'' asx asx')
            from n -{V}asxdd n'' obtain ai ais where "asx = ai#ais"
              by(cases asx)(auto dest:DynPDG_ddep_edge_CFG_path)
            with n -{V}asxdd n'' have "sourcenode ai = n"
              by(fastforce dest:DynPDG_ddep_edge_CFG_path elim:path.cases)
            from n -{V}asxdd n'' asx = ai#ais
            have "last(targetnodes asx) = n''"
              by(fastforce intro:path_targetnode dest:DynPDG_ddep_edge_CFG_path)
            { fix V' assume "V'  Use n"
              from n -{V}asxdd n'' have "(V,[],[])  dependent_live_vars n''"
                by(fastforce elim:DynPDG_edge.cases dep_vars_Use 
                            simp:dyn_data_dependence_def)
              with n'' -asx'd* n' have "(V,[],[]@asx')  dependent_live_vars n'"
                by(rule dependent_live_vars_dep_dependent_live_vars)
              have "(V',[],as)  dependent_live_vars n'"
              proof(cases "asx' = []")
                case True
                with n'' -asx'd* n' have "n'' = n'"
                  by(fastforce intro:DynPDG_empty_path_eq_nodes)
                with n -{V}asxdd n'' V'  Use n True as = a'#as'
                  a'#as' = asx@asx'
                show ?thesis by(fastforce intro:dependent_live_vars_ddep_empty_fst)
              next
                case False
                with n -{V}asxdd n'' asx = ai#ais
                  (V,[],[]@asx')  dependent_live_vars n'
                have "(V,ais@[],ais@asx')  dependent_live_vars n'"
                  by(fastforce intro:ddep_dependent_live_vars_keep_notempty)
                from n'' -asx'd* n' False have "last(targetnodes asx') = n'"
                  by -(rule path_targetnode,rule DynPDG_path_CFG_path)
                with (V,ais@[],ais@asx')  dependent_live_vars n'
                  V'  Use n n -{V}asxdd n'' asx = ai#ais
                  sourcenode ai = n ‹last(targetnodes asx) = n'' False
                have "(V',[],ai#ais@asx')  dependent_live_vars n'"
                  by(fastforce intro:dep_vars_Cons_ddep simp:targetnodes_def)
                with asx = ai#ais a'#as' = asx@asx' as = a'#as'
                show ?thesis by simp
              qed
              with all have "state_val s V' = state_val s' V'" by blast }
            with ‹pred ex' s' valid_edge a'
            show ?thesis by(fastforce elim:CFG_edge_Uses_pred_equal)
          qed
        qed
      qed simp
      with all' ‹preds esx (transfer ex s) es = ex#esx es' = ex'#esx'
      show ?thesis by simp
    next
      case False
      then obtain V' xs' where "(V',xs',as')  dependent_live_vars n'"
        and "state_val (transfer ex s) V'  state_val (transfer ex' s') V'"
        by auto
      show ?thesis
      proof(cases "n -a'#as'd* n'")
        case True
        with ‹slice_path as = x#xs as = a'#as' ‹last(targetnodes as) = n' ex
        have [simp]:"ex = kind a'" by clarsimp
        with x  y ex ex' have [simp]:"ex' = ex" by(cases x) auto
        { fix V assume "V  Use (sourcenode a')"
          hence "(V,[],[])  dependent_live_vars (sourcenode a')"
            by(rule dep_vars_Use)
          with n -a'#as'd* n' have "(V,[],[]@a'#as')  dependent_live_vars n'"
            by(fastforce intro:dependent_live_vars_dep_dependent_live_vars)
          with all as = a'#as' have "state_val s V = state_val s' V"
            by fastforce }
        with ‹pred ex' s' valid_edge a' have "pred ex s"
          by(fastforce intro:CFG_edge_Uses_pred_equal)
        show ?thesis
        proof(cases "V'  Def n")
          case True
          with state_val (transfer ex s) V'  state_val (transfer ex' s') V'
            valid_edge a' ‹pred ex' s' ‹pred ex s
            CFG_edge_transfer_uses_only_Use[of a' s s']
          obtain V'' where "V''  Use n"
            and "state_val s V''  state_val s' V''"
            by auto
          from True (V',xs',as')  dependent_live_vars n'
            targetnode a' -as'→* n' ‹last(targetnodes as) = n' as = a'#as'
            valid_edge a' n = sourcenode a'[THEN sym]
          have "n -{V'}a'#xs'dd last(targetnodes (a'#xs'))"
            by -(drule dependent_live_vars_dependent_edge,
              auto dest!: dependent_live_vars_dependent_edge 
                   dest:DynPDG_ddep_edge_CFG_path path_targetnode 
                   simp del:n = sourcenode a')
          with (V',xs',as')  dependent_live_vars n' V''  Use n
            ‹last(targetnodes as) = n' as = a'#as'
          have "(V'',[],as)  dependent_live_vars n'" 
            by(fastforce intro:dep_vars_Cons_ddep)
          with all have "state_val s V'' = state_val s' V''" by blast
          with state_val s V''  state_val s' V'' have False by simp
          thus ?thesis by simp
        next
          case False
          with valid_edge a' ‹pred ex s
          have "state_val (transfer (kind a') s) V' = state_val s V'"
            by(fastforce intro:CFG_edge_no_Def_equal)
          moreover
          from False valid_edge a' ‹pred ex' s'
          have "state_val (transfer (kind a') s') V' = state_val s' V'"
            by(fastforce intro:CFG_edge_no_Def_equal)
          ultimately have "state_val s V'  state_val s' V'"
            using state_val (transfer ex s) V'  state_val (transfer ex' s') V'
            by simp
          from False have "¬ n -{V'}a'#xs'dd 
                           last(targetnodes (a'#xs'))"
            by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
          with (V',xs',as')  dependent_live_vars n' ‹last(targetnodes as) = n'
            as = a'#as'
          have "(V',a'#xs',a'#as')  dependent_live_vars n'"
            by(fastforce intro:dep_vars_Cons_keep)
          with as = a'#as' all have "state_val s V' = state_val s' V'" by auto
          with state_val s V'  state_val s' V' have False by simp
          thus ?thesis by simp
        qed
      next
        case False
        { assume "V'  Def n"
          with (V',xs',as')  dependent_live_vars n' targetnode a' -as'→* n'
            valid_edge a'
          have "n -a'#as'd* n'"
            by -(drule dependent_live_vars_dependent_edge,
              auto dest:DynPDG_path_ddep DynPDG_path_Append)
          with False have "False" by simp }
        hence "V'  Def (sourcenode a')" by fastforce
        from False ‹slice_path as = x#xs as = a'#as'
          ‹last(targetnodes as) = n' as'  []
        have "¬ x" by(auto simp:targetnodes_def)
        with ex have cases:"ex = (case kind a' of f  id | (Q)  (λs. True))"
          by simp
        have "state_val s V'  state_val s' V'"
        proof(cases y)
          case True
          with ex' have [simp]:"ex' = kind a'" by simp
          from V'  Def (sourcenode a') valid_edge a' ‹pred ex' s'
          have states_eq:"state_val (transfer (kind a') s') V' = state_val s' V'"
            by(fastforce intro:CFG_edge_no_Def_equal)
          from cases have "state_val s V' = state_val (transfer ex s) V'"
            by(cases "kind a'") auto
          with states_eq
            state_val (transfer ex s) V'  state_val (transfer ex' s') V'
          show ?thesis by simp
        next
          case False
          with ex' have "ex' = (case kind a' of f  id | (Q)  (λs. True))"
            by simp
          with cases have "state_val s V' = state_val (transfer ex s) V'"
            and "state_val s' V' = state_val (transfer ex' s') V'"
            by(cases "kind a'",auto)+
          with state_val (transfer ex s) V'  state_val (transfer ex' s') V' 
          show ?thesis by simp
        qed
        from V'  Def (sourcenode a') 
        have "¬ n -{V'}a'#xs'dd last(targetnodes (a'#xs'))"
          by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
        with (V',xs',as')  dependent_live_vars n' ‹last(targetnodes as) = n'
          as = a'#as'
        have "(V',a'#xs',a'#as')  dependent_live_vars n'"
          by(fastforce intro:dep_vars_Cons_keep)
        with as = a'#as' all have "state_val s V' = state_val s' V'" by auto
        with state_val s V'  state_val s' V' have False by simp
        thus ?thesis by simp
      qed
    qed
  qed
qed simp_all


theorem fundamental_property_of_path_slicing:
  assumes "n -as→* n'" and "preds (kinds as) s"
  shows "(V  Use n'. state_val (transfers (slice_kinds as) s) V = 
                         state_val (transfers (kinds as) s) V)" 
  and "preds (slice_kinds as) s"
proof -
  have "length as = length (slice_path as)" by(simp add:slice_path_length)
  hence "slice_path as b replicate (length as) True"
    by(simp add:maximal_element)
  have "select_edge_kinds as (replicate (length as) True) = kinds as"
    by(rule select_edge_kinds_max_bv)
  with n -as→* n' ‹slice_path as b replicate (length as) True›
    ‹preds (kinds as) s 
  have "(VUse n'. state_val (transfers (slice_kinds as) s) V =
       state_val (transfers (kinds as) s) V)  preds (slice_kinds as) s"
    by -(rule slice_path_leqs_information_same_Uses,simp_all add:slice_kinds_def)
  thus "VUse n'. state_val (transfers (slice_kinds as) s) V =
    state_val (transfers (kinds as) s) V" and "preds (slice_kinds as) s"
    by simp_all
qed

end


subsection ‹The fundamental property of (dynamic) slicing related to the semantics›

locale BackwardPathSlice_wf = 
  DynPDG sourcenode targetnode kind valid_edge Entry Def Use state_val Exit 
    dyn_control_dependence +
  CFG_semantics_wf sourcenode targetnode kind valid_edge Entry sem identifies
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and dyn_control_dependence :: "'node  'node  'edge list  bool" 
    ("_ controls _ via _" [51, 0, 0] 1000)
  and Exit :: "'node" ("'('_Exit'_')") 
  and sem :: "'com  'state  'com  'state  bool" 
    ("((1_,/_) / (1_,/_))" [0,0,0,0] 81)
  and identifies :: "'node  'com  bool" ("_  _" [51, 0] 80) 

begin

theorem fundamental_property_of_path_slicing_semantically:
  assumes "n  c" and "c,s  c',s'"
  obtains n' as where "n -as→* n'" and "preds (slice_kinds as) s" 
  and "n'  c'" 
  and "V  Use n'. state_val (transfers (slice_kinds as) s) V = 
                     state_val s' V"
proof(atomize_elim)
  from n  c c,s  c',s' obtain n' as where "n -as→* n'"
    and "transfers (kinds as) s = s'"
    and "preds (kinds as) s"
    and "n'  c'"
    by(fastforce dest:fundamental_property)
  with n -as→* n' ‹preds (kinds as) s 
  have "V  Use n'. state_val (transfers (slice_kinds as) s) V =
    state_val (transfers (kinds as) s) V" and "preds (slice_kinds as) s"
    by -(rule fundamental_property_of_path_slicing,simp_all)+
  with ‹transfers (kinds as) s = s' have "V  Use n'. 
    state_val (transfers (slice_kinds as) s) V =
    state_val s' V" by simp
  with n -as→* n' ‹preds (slice_kinds as) s n'  c'
  show "as n'. n -as→* n'  preds (slice_kinds as) s  n'  c' 
       (VUse n'. state_val (transfers (slice_kinds as) s) V = state_val s' V)"
    by blast
qed


end

end

Theory Observable

section ‹Observable Sets of Nodes›

theory Observable imports "../Basic/CFG" begin

context CFG begin

inductive_set obs :: "'node  'node set  'node set" 
for n::"'node" and S::"'node set"
where obs_elem: 
  "n -as→* n'; nx  set(sourcenodes as). nx  S; n'  S  n'  obs n S"


lemma obsE:
  assumes "n'  obs n S"
  obtains as where "n -as→* n'" and "nx  set(sourcenodes as). nx  S"
  and "n'  S"
proof(atomize_elim)
  from n'  obs n S 
  have "as. n -as→* n'  (nx  set(sourcenodes as). nx  S)  n'  S"
    by(auto elim:obs.cases)
  thus "as. n -as→* n'  (nxset (sourcenodes as). nx  S)  n'  S" by blast
qed


lemma n_in_obs:
  assumes "valid_node n" and "n  S" shows "obs n S = {n}"
proof -
  from ‹valid_node n have "n -[]→* n" by(rule empty_path)
  with n  S have "n  obs n S" by(fastforce elim:obs_elem simp:sourcenodes_def)
  { fix n' assume "n'  obs n S"
    have "n' = n"
    proof(rule ccontr)
      assume "n'  n"
      from n'  obs n S obtain as where "n -as→* n'"
        and "nx  set(sourcenodes as). nx  S"
        and "n'  S" by(erule obsE)
      from n -as→* n' nx  set(sourcenodes as). nx  S n'  n n  S
      show False
      proof(induct rule:path.induct)
        case (Cons_path n'' as n' a n)
        from nxset (sourcenodes (a#as)). nx  S sourcenode a = n
        have "n  S" by(simp add:sourcenodes_def)
        with n  S show False by simp
      qed simp
    qed }
  with n  obs n S show ?thesis by fastforce
qed


lemma in_obs_valid:
  assumes "n'  obs n S" shows "valid_node n" and "valid_node n'"
  using n'  obs n S
  by(auto elim:obsE intro:path_valid_node)


lemma edge_obs_subset:
  assumes"valid_edge a" and "sourcenode a  S"
  shows "obs (targetnode a) S  obs (sourcenode a) S"
proof
  fix n assume "n  obs (targetnode a) S"
  then obtain as where "targetnode a -as→* n" 
    and all:"nx  set(sourcenodes as). nx  S" and "n  S" by(erule obsE)
  from valid_edge a targetnode a -as→* n
  have "sourcenode a -a#as→* n" by(fastforce intro:Cons_path)
  moreover
  from all sourcenode a  S have "nx  set(sourcenodes (a#as)). nx  S"
    by(simp add:sourcenodes_def)
  ultimately show "n  obs (sourcenode a) S" using n  S
    by(rule obs_elem)
qed


lemma path_obs_subset:
  "n -as→* n'; n'  set(sourcenodes as). n'  S
   obs n' S  obs n S"
proof(induct rule:path.induct)
  case (Cons_path n'' as n' a n)
  note IH = n'set (sourcenodes as). n'  S  obs n' S  obs n'' S
  from n'set (sourcenodes (a#as)). n'  S 
  have all:"n'set (sourcenodes as). n'  S" and "sourcenode a  S"
    by(simp_all add:sourcenodes_def)
  from IH[OF all] have "obs n' S  obs n'' S" .
  from valid_edge a targetnode a = n'' sourcenode a = n sourcenode a  S
  have "obs n'' S  obs n S" by(fastforce dest:edge_obs_subset)
  with ‹obs n' S  obs n'' S show ?case by fastforce
qed simp


lemma path_ex_obs:
  assumes "n -as→* n'" and "n'  S"
  obtains m where "m  obs n S"
proof(atomize_elim)
  show "m. m  obs n S"
  proof(cases "nx  set(sourcenodes as). nx  S")
    case True
    with n -as→* n' n'  S have "n'  obs n S" by -(rule obs_elem)
    thus ?thesis by fastforce
  next
    case False
    hence "nx  set(sourcenodes as). nx  S" by fastforce
    then obtain nx ns ns' where "sourcenodes as = ns@nx#ns'"
      and "nx  S" and "n'  set ns. n'  S"
      by(fastforce elim!:split_list_first_propE)
    from ‹sourcenodes as = ns@nx#ns' obtain as' a as'' 
      where "ns = sourcenodes as'"
      and "as = as'@a#as''" and "sourcenode a = nx"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with n -as→* n' have "n -as'→* nx" by(fastforce dest:path_split)
    with nx  S n'  set ns. n'  S ns = sourcenodes as' have "nx  obs n S"
      by(fastforce intro:obs_elem)
    thus ?thesis by fastforce
  qed
qed

end

end

Theory Distance

chapter ‹Static Intraprocedural Slicing›

theory Distance imports "../Basic/CFG" begin

text ‹
  Static Slicing analyses a CFG prior to execution. Whereas dynamic
  slicing can provide better results for certain inputs (i.e.\ trace and
  initial state), static slicing is more conservative but provides
  results independent of inputs. 

  Correctness for static slicing is
  defined differently than correctness of dynamic slicing by a weak
  simulation between nodes and states when traversing the original and
  the sliced graph. The weak simulation property demands that if a
  (node,state) tuples $(n_1,s_1)$ simulates $(n_2,s_2)$
  and making an observable move in the original graph leads from 
  $(n_1,s_1)$ to $(n_1',s_1')$, this tuple simulates a 
  tuple $(n_2,s_2)$ which is the result of making an
  observable move in the sliced graph beginning in $(n_2',s_2')$.

  We also show how a ``dynamic slicing style'' correctness criterion for 
  static slicing of a given trace and initial state could look like.

  This formalization of static intraprocedural slicing is instantiable
  with three different kinds of control dependences: standard control,
  weak control and weak order dependence. The correctness proof for
  slicing is independent of the control dependence used, it bases only
  on one property every control dependence definition hass to fulfill.
›

section ‹Distance of Paths›

context CFG begin

inductive distance :: "'node  'node  nat  bool"
where distanceI: 
  "n -as→* n'; length as = x; as'. n -as'→* n'  x  length as'
   distance n n' x"


lemma every_path_distance:
  assumes "n -as→* n'"
  obtains x where "distance n n' x" and "x  length as"
proof -
  have "x. distance n n' x  x  length as"
  proof(cases "as'. n -as'→* n'  
                     (asx. n -asx→* n'  length as'  length asx)")
    case True
    then obtain as' 
      where "n -as'→* n'  (asx. n -asx→* n'  length as'  length asx)" 
      by blast
    hence "n -as'→* n'" and all:"asx. n -asx→* n'  length as'  length asx"
      by simp_all
    hence "distance n n' (length as')" by(fastforce intro:distanceI)
    from n -as→* n' all have "length as'  length as" by fastforce
    with ‹distance n n' (length as') show ?thesis by blast
  next
    case False
    hence all:"as'. n -as'→* n'  (asx. n -asx→* n'  length as' > length asx)"
      by fastforce
    have "wf (measure length)" by simp
    from n -as→* n' have "as  {as. n -as→* n'}" by simp
    with ‹wf (measure length) obtain as' where "as'  {as. n -as→* n'}" 
      and notin:"as''. (as'',as')  (measure length)  as''  {as. n -as→* n'}"
      by(erule wfE_min)
    from as'  {as. n -as→* n'} have "n -as'→* n'" by simp
    with all obtain asx where "n -asx→* n'"
      and "length as' > length asx"
      by blast
    with notin have  "asx  {as. n -as→* n'}" by simp
    hence "¬ n -asx→* n'" by simp
    with n -asx→* n' have False by simp
    thus ?thesis by simp
  qed
  with that show ?thesis by blast
qed


lemma distance_det:
  "distance n n' x; distance n n' x'  x = x'"
apply(erule distance.cases)+ apply clarsimp
apply(erule_tac x="asa" in allE) apply(erule_tac x="as" in allE)
by simp


lemma only_one_SOME_dist_edge:
  assumes valid:"valid_edge a" and dist:"distance (targetnode a) n' x"
  shows "∃!a'. sourcenode a = sourcenode a'  distance (targetnode a') n' x 
               valid_edge a' 
               targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                              distance (targetnode a') n' x 
                                              valid_edge a'  targetnode a' = nx)"
proof(rule ex_ex1I)
  show "a'. sourcenode a = sourcenode a'  
             distance (targetnode a') n' x  valid_edge a' 
             targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a'  
                                            distance (targetnode a') n' x 
                                            valid_edge a'  targetnode a' = nx)"
  proof -
    have "(a'. sourcenode a = sourcenode a'  
                distance (targetnode a') n' x  valid_edge a'  
                targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                               distance (targetnode a') n' x 
                                               valid_edge a'  targetnode a' = nx)) =
      (nx. a'. sourcenode a = sourcenode a'  distance (targetnode a') n' x  
                 valid_edge a'  targetnode a' = nx)"
      apply(unfold some_eq_ex[of "λnx. a'. sourcenode a = sourcenode a'  
                distance (targetnode a') n' x valid_edge a'   targetnode a' = nx"])
      by simp
    also have "" using valid dist by blast
    finally show ?thesis .
  qed
next
  fix a' ax
  assume "sourcenode a = sourcenode a'  
    distance (targetnode a') n' x  valid_edge a' 
    targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a'  
                                   distance (targetnode a') n' x  
                                   valid_edge a'  targetnode a' = nx)"
    and "sourcenode a = sourcenode ax  
    distance (targetnode ax) n' x  valid_edge ax 
    targetnode ax = (SOME nx. a'. sourcenode a = sourcenode a' 
                                   distance (targetnode a') n' x  
                                   valid_edge a'  targetnode a' = nx)"
  thus "a' = ax" by(fastforce intro!:edge_det)
qed


lemma distance_successor_distance:
  assumes "distance n n' x" and "x  0" 
  obtains a where "valid_edge a" and "n = sourcenode a" 
  and "distance (targetnode a) n' (x - 1)"
  and "targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') n' (x - 1) 
                                     valid_edge a'  targetnode a' = nx)"
proof -
  have "a. valid_edge a  n = sourcenode a  distance (targetnode a) n' (x - 1) 
    targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                  distance (targetnode a') n' (x - 1) 
                                  valid_edge a'  targetnode a' = nx)"
  proof(rule ccontr)
    assume "¬ (a. valid_edge a  n = sourcenode a  
                   distance (targetnode a) n' (x - 1)  
                   targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                                 distance (targetnode a') n' (x - 1) 
                                                 valid_edge a'  targetnode a' = nx))"
    hence imp:"a. valid_edge a  n = sourcenode a 
                   targetnode a = (SOME nx. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') n' (x - 1) 
                                                 valid_edge a'  targetnode a' = nx)
                  ¬ distance (targetnode a) n' (x - 1)" by blast
    from ‹distance n n' x obtain as where "n -as→* n'" and "x = length as"
      and "as'. n -as'→* n'  x  length as'"
      by(auto elim:distance.cases)
    thus False using imp
    proof(induct rule:path.induct)
      case (empty_path n)
      from x = length [] x  0 show False by simp
    next
      case (Cons_path n'' as n' a n)
      note imp = a. valid_edge a  n = sourcenode a 
                      targetnode a = (SOME nx. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') n' (x - 1) 
                                                 valid_edge a'  targetnode a' = nx)
                     ¬ distance (targetnode a) n' (x - 1)
      note all = as'. n -as'→* n'  x  length as'
      from n'' -as→* n' obtain y where "distance n'' n' y"
        and "y  length as" by(erule every_path_distance)
      from ‹distance n'' n' y obtain as' where "n'' -as'→* n'"
        and "y = length as'"
        by(auto elim:distance.cases)
      show False
      proof(cases "y < length as")
        case True
        from valid_edge a sourcenode a = n targetnode a = n'' n'' -as'→* n'
        have "n -a#as'→* n'" by -(rule path.Cons_path)
        with all have "x  length (a#as')" by blast
        with x = length (a#as) True y = length as' show False by simp
      next
        case False
        with y  length as x = length (a#as) have "y = x - 1" by simp
        from targetnode a = n'' ‹distance n'' n' y
        have "distance (targetnode a) n' y" by simp
        with valid_edge a
        obtain a' where "sourcenode a = sourcenode a'"
          and "distance (targetnode a') n' y" and "valid_edge a'"
          and "targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                              distance (targetnode a') n' y 
                                              valid_edge a'  targetnode a' = nx)"
          by(auto dest:only_one_SOME_dist_edge)
        with imp sourcenode a = n y = x - 1 show False by fastforce
      qed
    qed
  qed
  with that show ?thesis by blast
qed

end

end


Theory DataDependence

section ‹Static data dependence›

theory DataDependence imports "../Basic/DynDataDependence" begin

context CFG_wf begin

definition data_dependence :: "'node  'var  'node  bool"
    ("_ influences _ in _" [51,0])
where data_dependences_eq:"n influences V in n'  as. n influences V in n' via as"

lemma data_dependence_def: "n influences V in n' = 
  (a' as'. (V  Def n)  (V  Use n') 
                 (n -a'#as'→* n')  (n''  set (sourcenodes as'). V  Def n''))"
by(auto simp:data_dependences_eq dyn_data_dependence_def)

end

end

Theory Slice

section ‹Static backward slice›

theory Slice 
  imports Observable Distance DataDependence "../Basic/SemanticsCFG"  
begin

locale BackwardSlice = 
  CFG_wf sourcenode targetnode kind valid_edge Entry Def Use state_val
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val" +
  fixes backward_slice :: "'node set  'node set"
  assumes valid_nodes:"n  backward_slice S  valid_node n"
  and refl:"valid_node n; n  S  n  backward_slice S"
  and dd_closed:"n'  backward_slice S; n influences V in n' 
   n  backward_slice S"
  and obs_finite:"finite (obs n (backward_slice S))"
  and obs_singleton:"card (obs n (backward_slice S))  1"

begin

lemma slice_n_in_obs:
  "n  backward_slice S  obs n (backward_slice S) = {n}"
by(fastforce intro!:n_in_obs dest:valid_nodes)

lemma obs_singleton_disj: 
  "(m. obs n (backward_slice S) = {m})  obs n (backward_slice S) = {}"
proof -
  have "finite(obs n (backward_slice S))" by(rule obs_finite)
  show ?thesis
  proof(cases "card(obs n (backward_slice S)) = 0")
    case True
    with ‹finite(obs n (backward_slice S)) have "obs n (backward_slice S) = {}"
      by simp
    thus ?thesis by simp
  next
    case False
    have "card(obs n (backward_slice S))  1" by(rule obs_singleton)
    with False have "card(obs n (backward_slice S)) = 1"
      by simp
    hence "m. obs n (backward_slice S) = {m}" by(fastforce dest:card_eq_SucD)
    thus ?thesis by simp
  qed
qed


lemma obs_singleton_element:
  assumes "m  obs n (backward_slice S)" shows "obs n (backward_slice S) = {m}"
proof -
  have "(m. obs n (backward_slice S) = {m})  obs n (backward_slice S) = {}"
    by(rule obs_singleton_disj)
  with m  obs n (backward_slice S) show ?thesis by fastforce
qed


lemma obs_the_element: 
  "m  obs n (backward_slice S)  (THE m. m  obs n (backward_slice S)) = m"
by(fastforce dest:obs_singleton_element)


subsection ‹Traversing the sliced graph›

text slice_kind S a› conforms to @{term "kind a"} in the
  sliced graph›

definition slice_kind :: "'node set  'edge  'state edge_kind"
  where "slice_kind S a = (let S' = backward_slice S; n = sourcenode a in 
  (if sourcenode a  S' then kind a
   else (case kind a of f  id | (Q)  
    (if obs (sourcenode a) S' = {} then 
      (let nx = (SOME n'. a'. n = sourcenode a'  valid_edge a'  targetnode a' = n')
      in (if (targetnode a = nx) then (λs. True) else (λs. False)))
     else (let m = THE m. m  obs n S' in 
       (if (x. distance (targetnode a) m x  distance n m (x + 1) 
            (targetnode a = (SOME nx'. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') m x 
                                     valid_edge a'  targetnode a' = nx'))) 
          then (λs. True) else (λs. False)
       ))
     ))
  ))"


definition
  slice_kinds :: "'node set  'edge list  'state edge_kind list"
  where "slice_kinds S as  map (slice_kind S) as"


lemma slice_kind_in_slice:
  "sourcenode a  backward_slice S  slice_kind S a = kind a"
by(simp add:slice_kind_def)


lemma slice_kind_Upd:
  "sourcenode a  backward_slice S; kind a = f  slice_kind S a = id"
by(simp add:slice_kind_def)


lemma slice_kind_Pred_empty_obs_SOME:
  "sourcenode a  backward_slice S; kind a = (Q); 
    obs (sourcenode a) (backward_slice S) = {}; 
    targetnode a = (SOME n'. a'. sourcenode a = sourcenode a'  valid_edge a' 
                                  targetnode a' = n')
   slice_kind S a = (λs. True)"
by(simp add:slice_kind_def)


lemma slice_kind_Pred_empty_obs_not_SOME:
  "sourcenode a  backward_slice S; kind a = (Q); 
    obs (sourcenode a) (backward_slice S) = {}; 
    targetnode a  (SOME n'. a'. sourcenode a = sourcenode a'  valid_edge a' 
                                  targetnode a' = n')
   slice_kind S a = (λs. False)"
by(simp add:slice_kind_def)


lemma slice_kind_Pred_obs_nearer_SOME:
  assumes "sourcenode a  backward_slice S" and "kind a = (Q)" 
  and "m  obs (sourcenode a) (backward_slice S)"
  and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
  and "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                          distance (targetnode a') m x 
                                          valid_edge a'  targetnode a' = n')"
  shows "slice_kind S a = (λs. True)"
proof -
  from m  obs (sourcenode a) (backward_slice S)
  have "m = (THE m. m  obs (sourcenode a) (backward_slice S))"
    by(rule obs_the_element[THEN sym])
  with assms show ?thesis
    by(fastforce simp:slice_kind_def Let_def)
qed


lemma slice_kind_Pred_obs_nearer_not_SOME:
  assumes "sourcenode a  backward_slice S" and "kind a = (Q)" 
  and "m  obs (sourcenode a) (backward_slice S)"
  and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
  and "targetnode a  (SOME nx'. a'. sourcenode a = sourcenode a'  
                                          distance (targetnode a') m x 
                                          valid_edge a'  targetnode a' = nx')"
  shows "slice_kind S a = (λs. False)"
proof -
  from m  obs (sourcenode a) (backward_slice S)
  have "m = (THE m. m  obs (sourcenode a) (backward_slice S))"
    by(rule obs_the_element[THEN sym])
  with assms show ?thesis
    by(fastforce dest:distance_det simp:slice_kind_def Let_def)
qed


lemma slice_kind_Pred_obs_not_nearer:
  assumes "sourcenode a  backward_slice S" and "kind a = (Q)" 
  and in_obs:"m  obs (sourcenode a) (backward_slice S)"
  and dist:"distance (sourcenode a) m (x + 1)" 
           "¬ distance (targetnode a) m x"
  shows "slice_kind S a = (λs. False)"
proof -
  from in_obs have the:"m = (THE m. m  obs (sourcenode a) (backward_slice S))"
    by(rule obs_the_element[THEN sym])
  from dist have "¬ (x. distance (targetnode a) m x  
                            distance (sourcenode a) m (x + 1))"
    by(fastforce dest:distance_det)
  with sourcenode a  backward_slice S kind a = (Q) in_obs the show ?thesis
    by(fastforce simp:slice_kind_def Let_def)
qed


lemma kind_Predicate_notin_slice_slice_kind_Predicate:
  assumes "kind a = (Q)" and "sourcenode a  backward_slice S"
  obtains Q' where "slice_kind S a = (Q')" and "Q' = (λs. False)  Q' = (λs. True)"
proof(atomize_elim)
  show "Q'. slice_kind S a = (Q')  (Q' = (λs. False)  Q' = (λs. True))"
  proof(cases "obs (sourcenode a) (backward_slice S) = {}")
    case True
    show ?thesis
    proof(cases "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a'  
                                               valid_edge a'  targetnode a' = n')")
      case True
      with sourcenode a  backward_slice S kind a = (Q)
        ‹obs (sourcenode a) (backward_slice S) = {}
      have "slice_kind S a = (λs. True)" by(rule slice_kind_Pred_empty_obs_SOME)
      thus ?thesis by simp
    next
      case False
      with sourcenode a  backward_slice S kind a = (Q)
        ‹obs (sourcenode a) (backward_slice S) = {}
      have "slice_kind S a = (λs. False)"
        by(rule slice_kind_Pred_empty_obs_not_SOME)
      thus ?thesis by simp
    qed
  next
    case False
    then obtain m where "m  obs (sourcenode a) (backward_slice S)" by blast
    show ?thesis
    proof(cases "x. distance (targetnode a) m x  
        distance (sourcenode a) m (x + 1)")
      case True
      then obtain x where "distance (targetnode a) m x" 
        and "distance (sourcenode a) m (x + 1)" by blast
      show ?thesis
      proof(cases "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') m x 
                                                 valid_edge a'  targetnode a' = n')")
        case True
        with sourcenode a  backward_slice S kind a = (Q)
          m  obs (sourcenode a) (backward_slice S)
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
        have "slice_kind S a = (λs. True)"
          by(rule slice_kind_Pred_obs_nearer_SOME)
        thus ?thesis by simp
      next
        case False
        with sourcenode a  backward_slice S kind a = (Q)
          m  obs (sourcenode a) (backward_slice S)
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
        have "slice_kind S a = (λs. False)"
          by(rule slice_kind_Pred_obs_nearer_not_SOME)
        thus ?thesis by simp
      qed
    next
      case False
      from m  obs (sourcenode a) (backward_slice S)
      have "m = (THE m. m  obs (sourcenode a) (backward_slice S))"
        by(rule obs_the_element[THEN sym])
      with sourcenode a  backward_slice S kind a = (Q) False
        m  obs (sourcenode a) (backward_slice S)
      have "slice_kind S a = (λs. False)"
        by(fastforce simp:slice_kind_def Let_def)
      thus ?thesis by simp
    qed
  qed
qed


lemma only_one_SOME_edge:
  assumes "valid_edge a"
  shows "∃!a'. sourcenode a = sourcenode a'  valid_edge a' 
               targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                              valid_edge a'  targetnode a' = n')"
proof(rule ex_ex1I)
  show "a'. sourcenode a = sourcenode a'  valid_edge a' 
             targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                            valid_edge a'  targetnode a' = n')"
  proof -
    have "(a'. sourcenode a = sourcenode a'  valid_edge a' 
                targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                               valid_edge a'  targetnode a' = n')) =
      (n'. a'. sourcenode a = sourcenode a'  valid_edge a'  targetnode a' = n')"
      apply(unfold some_eq_ex[of "λn'. a'. sourcenode a = sourcenode a'  
                                            valid_edge a'  targetnode a' = n'"])
      by simp
    also have "" using valid_edge a by blast
    finally show ?thesis .
  qed
next
  fix a' ax
  assume "sourcenode a = sourcenode a'  valid_edge a' 
    targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                   valid_edge a'  targetnode a' = n')"
    and "sourcenode a = sourcenode ax  valid_edge ax 
    targetnode ax = (SOME n'. a'. sourcenode a = sourcenode a'  
                              valid_edge a'  targetnode a' = n')"
  thus "a' = ax" by(fastforce intro!:edge_det)
qed


lemma slice_kind_only_one_True_edge:
  assumes "sourcenode a = sourcenode a'" and "targetnode a  targetnode a'" 
  and "valid_edge a" and "valid_edge a'" and "slice_kind S a = (λs. True)"
  shows "slice_kind S a' = (λs. False)"
proof -
  from assms obtain Q Q' where "kind a = (Q)"
    and "kind a' = (Q')" and det:"s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    by(auto dest:deterministic)
  from valid_edge a have ex1:"∃!a'. sourcenode a = sourcenode a'  valid_edge a' 
               targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                              valid_edge a'  targetnode a' = n')"
    by(rule only_one_SOME_edge)
  show ?thesis
  proof(cases "sourcenode a  backward_slice S")
    case True
    with ‹slice_kind S a = (λs. True) kind a = (Q) have "Q = (λs. True)"
      by(simp add:slice_kind_def Let_def)
    with det have "Q' = (λs. False)" by(simp add:fun_eq_iff)
    with True kind a' = (Q') sourcenode a = sourcenode a' show ?thesis
      by(simp add:slice_kind_def Let_def)
  next
    case False
    hence "sourcenode a  backward_slice S" by simp
    thus ?thesis
    proof(cases "obs (sourcenode a) (backward_slice S) = {}")
      case True
      with sourcenode a  backward_slice S ‹slice_kind S a = (λs. True)
        kind a = (Q)
      have target:"targetnode a = (SOME n'. a'. sourcenode a = sourcenode a'  
                                                 valid_edge a'  targetnode a' = n')"
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
      have "targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                            valid_edge a'  targetnode a' = n')"
      proof(rule ccontr)
        assume "¬ targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                                 valid_edge a'  targetnode a' = n')"
        hence "targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                              valid_edge a'  targetnode a' = n')"
          by simp
        with ex1 target sourcenode a = sourcenode a' valid_edge a
          valid_edge a' have "a = a'" by blast
        with targetnode a  targetnode a' show False by simp
      qed
      with sourcenode a  backward_slice S True kind a' = (Q')
        sourcenode a = sourcenode a' show ?thesis 
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
    next
      case False
      hence "obs (sourcenode a) (backward_slice S)  {}" .
      then obtain m where "m  obs (sourcenode a) (backward_slice S)" by auto
      hence "m = (THE m. m  obs (sourcenode a) (backward_slice S))"
        by(auto dest:obs_the_element)
      with sourcenode a  backward_slice S 
        ‹obs (sourcenode a) (backward_slice S)  {} 
        ‹slice_kind S a = (λs. True) kind a = (Q)
      obtain x x' where "distance (targetnode a) m x" 
        "distance (sourcenode a) m (x + 1)"
        and target:"targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') m x 
                                                 valid_edge a'  targetnode a' = n')"
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
      show ?thesis
      proof(cases "distance (targetnode a') m x")
        case False
        with sourcenode a  backward_slice S kind a' = (Q')
          m  obs (sourcenode a) (backward_slice S)
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
          sourcenode a = sourcenode a' show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_not_nearer)
      next
        case True
        from valid_edge a ‹distance (targetnode a) m x
          ‹distance (sourcenode a) m (x + 1)
        have ex1:"∃!a'. sourcenode a = sourcenode a'  
               distance (targetnode a') m x  valid_edge a' 
               targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                              distance (targetnode a') m x 
                                              valid_edge a'  targetnode a' = nx)"
          by(fastforce intro!:only_one_SOME_dist_edge)
        have "targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                               distance (targetnode a') m x 
                                               valid_edge a'  targetnode a' = n')"
        proof(rule ccontr)
          assume "¬ targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                                 distance (targetnode a') m x 
                                                 valid_edge a'  targetnode a' = n')"
          hence "targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                distance (targetnode a') m x 
                                                valid_edge a'  targetnode a' = n')"
            by simp
          with ex1 target sourcenode a = sourcenode a' 
            valid_edge a valid_edge a' 
            ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
          have "a = a'" by auto
          with targetnode a  targetnode a' show False by simp
        qed
        with sourcenode a  backward_slice S 
          kind a' = (Q') m  obs (sourcenode a) (backward_slice S)
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
          True sourcenode a = sourcenode a' show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_nearer_not_SOME)
      qed
    qed
  qed
qed


lemma slice_deterministic:
  assumes "valid_edge a" and "valid_edge a'"
  and "sourcenode a = sourcenode a'" and "targetnode a  targetnode a'"
  obtains Q Q' where "slice_kind S a = (Q)" and "slice_kind S a' = (Q')"
  and "s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
proof(atomize_elim)
  from assms obtain Q Q' 
    where "kind a = (Q)" and "kind a' = (Q')" 
    and det:"s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    by(auto dest:deterministic)
  from valid_edge a have ex1:"∃!a'. sourcenode a = sourcenode a'  valid_edge a' 
               targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                              valid_edge a'  targetnode a' = n')"
    by(rule only_one_SOME_edge)
  show "Q Q'. slice_kind S a = (Q)  slice_kind S a' = (Q')  
                (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
  proof(cases "sourcenode a  backward_slice S")
    case True
    with kind a = (Q) have "slice_kind S a = (Q)"
      by(simp add:slice_kind_def Let_def)
    from True kind a' = (Q') sourcenode a = sourcenode a'
    have "slice_kind S a' = (Q')"
      by(simp add:slice_kind_def Let_def)
    with ‹slice_kind S a = (Q) det show ?thesis by blast
  next
    case False
    with kind a = (Q) 
    have "slice_kind S a = (λs. True)  slice_kind S a = (λs. False)"
      by(simp add:slice_kind_def Let_def)
    thus ?thesis
    proof
      assume true:"slice_kind S a = (λs. True)"
      with sourcenode a = sourcenode a' targetnode a  targetnode a'
        valid_edge a valid_edge a'
      have "slice_kind S a' = (λs. False)"
        by(rule slice_kind_only_one_True_edge)
      with true show ?thesis by simp
    next
      assume false:"slice_kind S a = (λs. False)"
      from False kind a' = (Q') sourcenode a = sourcenode a'
      have "slice_kind S a' = (λs. True)  slice_kind S a' = (λs. False)"
        by(simp add:slice_kind_def Let_def)
      with false show ?thesis by auto
    qed
  qed
qed




subsection ‹Observable and silent moves›

inductive silent_move :: 
  "'node set  ('edge  'state edge_kind)  'node  'state  'edge  
  'node  'state  bool" ("_,_  '(_,_') -_τ '(_,_')" [51,50,0,0,50,0,0] 51) 
 
  where silent_moveI:
  "pred (f a) s; transfer (f a) s = s'; sourcenode a  backward_slice S; 
    valid_edge a  
   S,f  (sourcenode a,s) -aτ (targetnode a,s')"


inductive silent_moves :: 
  "'node set  ('edge  'state edge_kind)  'node  'state  'edge list  
  'node  'state  bool" ("_,_  '(_,_') =_τ '(_,_')" [51,50,0,0,50,0,0] 51)

  where silent_moves_Nil: "S,f  (n,s) =[]τ (n,s)"

  | silent_moves_Cons:
  "S,f  (n,s) -aτ (n',s'); S,f  (n',s') =asτ (n'',s'') 
   S,f  (n,s) =a#asτ (n'',s'')"


lemma silent_moves_obs_slice:
  "S,f  (n,s) =asτ (n',s'); nx  obs n' (backward_slice S)
   nx  obs n (backward_slice S)"
proof(induct rule:silent_moves.induct)
  case silent_moves_Nil thus ?case by simp
next
  case (silent_moves_Cons S f n s a n' s' as n'' s'')
  from nx  obs n'' (backward_slice S)
    nx  obs n'' (backward_slice S)  nx  obs n' (backward_slice S)
  have obs:"nx  obs n' (backward_slice S)" by simp
  from S,f  (n,s) -aτ (n',s')
  have "n = sourcenode a" and "n' = targetnode a" and "valid_edge a" 
    and "n  (backward_slice S)"
    by(auto elim:silent_move.cases)
  hence "obs n' (backward_slice S)  obs n (backward_slice S)"
    by simp(rule edge_obs_subset,simp+)
  with obs show ?case by blast
qed


lemma silent_moves_preds_transfers_path:
  "S,f  (n,s) =asτ (n',s'); valid_node n 
   preds (map f as) s  transfers (map f as) s = s'  n -as→* n'"
proof(induct rule:silent_moves.induct)
  case silent_moves_Nil thus ?case by(simp add:path.empty_path)
next
  case (silent_moves_Cons S f n s a n' s' as n'' s'')
  note IH = ‹valid_node n' 
    preds (map f as) s'  transfers (map f as) s' = s''  n' -as→* n''
  from S,f  (n,s) -aτ (n',s') have "pred (f a) s" and "transfer (f a) s = s'"
    and "n = sourcenode a" and "n' = targetnode a" and "valid_edge a"
    by(auto elim:silent_move.cases)
  from n' = targetnode a valid_edge a have "valid_node n'" by simp
  from IH[OF this] have "preds (map f as) s'" and "transfers (map f as) s' = s''"
    and "n' -as→* n''" by simp_all
  from n = sourcenode a n' = targetnode a valid_edge a n' -as→* n''
  have "n -a#as→* n''" by(fastforce intro:Cons_path)
  with ‹pred (f a) s ‹preds (map f as) s' ‹transfer (f a) s = s' 
    ‹transfers (map f as) s' = s'' show ?case by simp
qed


lemma obs_silent_moves:
  assumes "obs n (backward_slice S) = {n'}"
  obtains as where "S,slice_kind S  (n,s) =asτ (n',s)"
proof(atomize_elim)
  from ‹obs n (backward_slice S) = {n'} 
  have "n'  obs n (backward_slice S)" by simp
  then obtain as where "n -as→* n'" 
    and "nx  set(sourcenodes as). nx  (backward_slice S)"
    and "n'  (backward_slice S)" by(erule obsE)
  from n -as→* n' obtain x where "distance n n' x" and "x  length as"
    by(erule every_path_distance)
  from ‹distance n n' x n'  obs n (backward_slice S) 
  show "as. S,slice_kind S  (n,s) =asτ (n',s)"
  proof(induct x arbitrary:n s rule:nat.induct)
    fix n s assume "distance n n' 0"
    then obtain as' where "n -as'→* n'" and "length as' = 0"
      by(auto elim:distance.cases)
    hence "n -[]→* n'" by(cases as) auto
    hence "n = n'" by(fastforce elim:path.cases)
    hence "S,slice_kind S  (n,s) =[]τ (n',s)" by(fastforce intro:silent_moves_Nil)
    thus "as. S,slice_kind S  (n,s) =asτ (n',s)" by blast
  next
    fix x n s 
    assume "distance n n' (Suc x)" and "n'  obs n (backward_slice S)"
      and IH:"n s. distance n n' x; n'  obs n (backward_slice S) 
               as. S,slice_kind S  (n,s) =asτ (n',s)"
    from n'  obs n (backward_slice S)
    have "valid_node n" by(rule in_obs_valid)
    with ‹distance n n' (Suc x)
    have "n  n'" by(fastforce elim:distance.cases dest:empty_path)
    have "n  backward_slice S"
    proof
      assume isin:"n  backward_slice S"
      with ‹valid_node n have "obs n (backward_slice S) = {n}"
        by(fastforce intro!:n_in_obs)
      with n'  obs n (backward_slice S) n  n' show False by simp
    qed
    from ‹distance n n' (Suc x) obtain a where "valid_edge a" 
      and "n = sourcenode a" and "distance (targetnode a) n' x"
      and target:"targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') n' x 
                                     valid_edge a'  targetnode a' = nx)"
      by -(erule distance_successor_distance,simp+)
    from n'  obs n (backward_slice S)
    have "obs n (backward_slice S) = {n'}"
      by(rule obs_singleton_element)
    with valid_edge a n  backward_slice S n = sourcenode a
    have disj:"obs (targetnode a) (backward_slice S) = {}  
               obs (targetnode a) (backward_slice S) = {n'}"
      by -(drule_tac S="backward_slice S" in edge_obs_subset,auto)
    from ‹distance (targetnode a) n' x obtain asx where "targetnode a -asx→* n'" 
      and "length asx = x" and "as'. targetnode a -as'→* n'  x  length as'" 
      by(auto elim:distance.cases)
    from targetnode a -asx→* n' n'  (backward_slice S)
    obtain m where "m. m  obs (targetnode a) (backward_slice S)"
      by(fastforce elim:path_ex_obs)
    with disj have "n'  obs (targetnode a) (backward_slice S)" by fastforce
    from IH[OF ‹distance (targetnode a) n' x this,of "transfer (slice_kind S a) s"]
    obtain asx' where 
    moves:"S,slice_kind S  (targetnode a,transfer (slice_kind S a) s) =asx'τ 
                               (n',transfer (slice_kind S a) s)" by blast
    have "pred (slice_kind S a) s  transfer (slice_kind S a) s = s"
    proof(cases "kind a")
      case (Update f)
      with n  backward_slice S n = sourcenode a have "slice_kind S a = id" 
        by(fastforce intro:slice_kind_Upd)
      thus ?thesis by simp
    next
      case (Predicate Q)
      with n  backward_slice S n = sourcenode a
        n'  obs n (backward_slice S) ‹distance (targetnode a) n' x
        ‹distance n n' (Suc x) target
      have "slice_kind S a =  (λs. True)"
        by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
      thus ?thesis by simp
    qed
    hence "pred (slice_kind S a) s" and "transfer (slice_kind S a) s = s"
      by simp_all
    with n  backward_slice S n = sourcenode a valid_edge a
    have "S,slice_kind S  (sourcenode a,s) -aτ 
                             (targetnode a,transfer (slice_kind S a) s)"
      by(fastforce intro:silent_moveI)
    with moves ‹transfer (slice_kind S a) s = s n = sourcenode a
    have "S,slice_kind S  (n,s) =a#asx'τ (n',s)"
      by(fastforce intro:silent_moves_Cons)
    thus "as. S,slice_kind S  (n,s) =asτ (n',s)" by blast
  qed
qed


inductive observable_move ::
  "'node set  ('edge  'state edge_kind)  'node  'state  'edge  
  'node  'state  bool" ("_,_  '(_,_') -_ '(_,_')" [51,50,0,0,50,0,0] 51) 
 
  where observable_moveI:
  "pred (f a) s; transfer (f a) s = s'; sourcenode a  backward_slice S; 
    valid_edge a  
   S,f  (sourcenode a,s) -a (targetnode a,s')"


inductive observable_moves :: 
  "'node set  ('edge  'state edge_kind)  'node  'state  'edge list  
  'node  'state  bool" ("_,_  '(_,_') =_ '(_,_')" [51,50,0,0,50,0,0] 51) 

  where observable_moves_snoc:
  "S,f  (n,s) =asτ (n',s'); S,f  (n',s') -a (n'',s'') 
   S,f  (n,s) =as@[a] (n'',s'')"


lemma observable_move_notempty:
  "S,f  (n,s) =as (n',s'); as = []  False"
by(induct rule:observable_moves.induct,simp)


lemma silent_move_observable_moves:
  "S,f  (n'',s'') =as (n',s'); S,f  (n,s) -aτ (n'',s'')
   S,f  (n,s) =a#as (n',s')"
proof(induct rule:observable_moves.induct)
  case (observable_moves_snoc S f nx sx as n' s' a' n'' s'')
  from S,f  (n,s) -aτ (nx,sx) S,f  (nx,sx) =asτ (n',s')
  have "S,f  (n,s) =a#asτ (n',s')" by(rule silent_moves_Cons)
  with S,f  (n',s') -a' (n'',s'')
  have "S,f  (n,s) =(a#as)@[a'] (n'',s'')"
    by -(rule observable_moves.observable_moves_snoc)
  thus ?case by simp
qed


lemma observable_moves_preds_transfers_path:
  "S,f  (n,s) =as (n',s')
   preds (map f as) s  transfers (map f as) s = s'  n -as→* n'"
proof(induct rule:observable_moves.induct)
  case (observable_moves_snoc S f n s as n' s' a n'' s'')
  have "valid_node n"
  proof(cases as)
    case Nil
    with S,f  (n,s) =asτ (n',s') have "n = n'" and "s = s'"
      by(auto elim:silent_moves.cases)
    with S,f  (n',s') -a (n'',s'') show ?thesis
      by(fastforce elim:observable_move.cases)
  next
    case (Cons a' as')
    with S,f  (n,s) =asτ (n',s') show ?thesis
      by(fastforce elim:silent_moves.cases silent_move.cases)
  qed
  with S,f  (n,s) =asτ (n',s')
  have "preds (map f as) s" and "transfers (map f as) s = s'"
    and "n -as→* n'" by(auto dest:silent_moves_preds_transfers_path)
  from S,f  (n',s') -a (n'',s'') have "pred (f a) s'" 
    and "transfer (f a) s' = s''" and "n' = sourcenode a" and "n'' = targetnode a" 
    and "valid_edge a"
    by(auto elim:observable_move.cases)
  from n' = sourcenode a n'' = targetnode a valid_edge a
  have "n' -[a]→* n''" by(fastforce intro:path.intros)
  with n -as→* n' have "n -as@[a]→* n''" by(rule path_Append)
  with ‹preds (map f as) s ‹pred (f a) s' ‹transfer (f a) s' = s''
    ‹transfers (map f as) s = s'
  show ?case by(simp add:transfers_split preds_split)
qed




subsection ‹Relevant variables›

inductive_set relevant_vars :: "'node set  'node  'var set" ("rv _")
for S :: "'node set" and n :: "'node"

where rvI:
  "n -as→* n'; n'  backward_slice S; V  Use n';
    nx  set(sourcenodes as). V  Def nx
   V  rv S n"


lemma rvE:
  assumes rv:"V  rv S n"
  obtains as n' where "n -as→* n'" and "n'  backward_slice S" and "V  Use n'"
  and "nx  set(sourcenodes as). V  Def nx"
using rv
by(atomize_elim,auto elim!:relevant_vars.cases)



lemma eq_obs_in_rv:
  assumes obs_eq:"obs n (backward_slice S) = obs n' (backward_slice S)" 
  and "x  rv S n" shows "x  rv S n'"
proof -
  from x  rv S n obtain as m 
    where "n -as→* m" and "m  backward_slice S" and "x  Use m"
    and "nxset (sourcenodes as). x  Def nx"
    by(erule rvE)
  from n -as→* m have "valid_node m" by(fastforce dest:path_valid_node)
  from n -as→* m m  backward_slice S 
  have "nx as' as''. nx  obs n (backward_slice S)  n -as'→* nx  
                                     nx -as''→* m  as = as'@as''"
  proof(cases "nx  set(sourcenodes as). nx  backward_slice S")
    case True
    with n -as→* m m  backward_slice S have "m  obs n (backward_slice S)"
      by -(rule obs_elem)
    with n -as→* m ‹valid_node m show ?thesis by(blast intro:empty_path)
  next
    case False
    hence "nx  set(sourcenodes as). nx  backward_slice S" by simp
    then obtain nx' ns ns' where "sourcenodes as = ns@nx'#ns'"
      and "nx'  backward_slice S" 
      and "x  set ns. x  backward_slice S"
      by(fastforce elim!:split_list_first_propE)
    from ‹sourcenodes as = ns@nx'#ns'
    obtain as' a' as'' where "ns = sourcenodes as'"
      and "as = as'@a'#as''" and "sourcenode a' = nx'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from n -as→* m as = as'@a'#as'' sourcenode a' = nx'
    have "n -as'→* nx'" and "valid_edge a'" and "targetnode a' -as''→* m"
      by(fastforce dest:path_split)+
    with sourcenode a' = nx' have "nx' -a'#as''→* m" by(fastforce intro:Cons_path)
    from n -as'→* nx' nx'  backward_slice S
      x  set ns. x  backward_slice S ns = sourcenodes as' 
    have "nx'  obs n (backward_slice S)" 
      by(fastforce intro:obs_elem)
    with n -as'→* nx' nx' -a'#as''→* m as = as'@a'#as'' show ?thesis by blast
  qed
  then obtain nx as' as'' where "nx  obs n (backward_slice S)"
    and "n -as'→* nx" and "nx -as''→* m" and "as = as'@as''"
    by blast
  from nx  obs n (backward_slice S) obs_eq 
  have "nx  obs n' (backward_slice S)" by auto
  then obtain asx where "n' -asx→* nx" 
    and "ni  set(sourcenodes asx). ni  backward_slice S" 
    and "nx  backward_slice S"
    by(erule obsE)
  from as = as'@as'' nxset (sourcenodes as). x  Def nx 
  have "niset (sourcenodes as''). x  Def ni"
    by(auto simp:sourcenodes_def)
  from ni  set(sourcenodes asx). ni  backward_slice S n' -asx→* nx
  have "ni  set(sourcenodes asx). x  Def ni"
  proof(induct asx arbitrary:n')
    case Nil thus ?case by(simp add:sourcenodes_def)
  next
    case (Cons ax' asx')
    note IH = n'. niset (sourcenodes asx'). ni  backward_slice S; 
      n' -asx'→* nx 
         niset (sourcenodes asx'). x  Def ni
    from n' -ax'#asx'→* nx have "n' -[]@ax'#asx'→* nx" by simp
    hence "targetnode ax' -asx'→* nx" and "n' = sourcenode ax'"
      by(fastforce dest:path_split)+
    from niset (sourcenodes (ax'#asx')). ni  backward_slice S
    have all:"niset (sourcenodes asx'). ni  backward_slice S" 
      and "sourcenode ax'  backward_slice S"
      by(auto simp:sourcenodes_def)
    from IH[OF all targetnode ax' -asx'→* nx]
    have "niset (sourcenodes asx'). x  Def ni" .
    with niset (sourcenodes as''). x  Def ni
    have "niset (sourcenodes (asx'@as'')). x  Def ni"
      by(auto simp:sourcenodes_def)
    from n' -ax'#asx'→* nx nx -as''→* m have "n' -(ax'#asx')@as''→* m" 
      by-(rule path_Append)
    hence "n' -ax'#asx'@as''→* m" by simp
    have "x  Def (sourcenode ax')"
    proof
      assume "x  Def (sourcenode ax')"
      with x  Use m niset (sourcenodes (asx'@as'')). x  Def ni
        n' -ax'#asx'@as''→* m n' = sourcenode ax' 
      have "n' influences x in m"
        by(auto simp:data_dependence_def)
      with m  backward_slice S dd_closed have "n'  backward_slice S" 
        by(auto simp:dd_closed)
      with n' = sourcenode ax' sourcenode ax'  backward_slice S
      show False by simp
    qed
    with niset (sourcenodes (asx'@as'')). x  Def ni
    show ?case by(simp add:sourcenodes_def)
  qed
  with niset (sourcenodes as''). x  Def ni 
  have "niset (sourcenodes (asx@as'')). x  Def ni"
    by(auto simp:sourcenodes_def)
  from n' -asx→* nx nx -as''→* m have "n' -asx@as''→* m" by(rule path_Append)
  with m  backward_slice S x  Use m 
    niset (sourcenodes (asx@as'')). x  Def ni show "x  rv S n'" by -(rule rvI)
qed


lemma closed_eq_obs_eq_rvs:
  fixes S :: "'node set"
  assumes "valid_node n" and "valid_node n'"
  and obs_eq:"obs n (backward_slice S) = obs n' (backward_slice S)"
  shows "rv S n = rv S n'"
proof
  show "rv S n  rv S n'"
  proof
    fix x assume "x  rv S n"
    with ‹valid_node n obs_eq show "x  rv S n'" by -(rule eq_obs_in_rv)
  qed
next
  show "rv S n'  rv S n"
  proof
    fix x assume "x  rv S n'"
    with ‹valid_node n' obs_eq[THEN sym] show "x  rv S n" by -(rule eq_obs_in_rv)
  qed
qed


lemma rv_edge_slice_kinds:
  assumes "valid_edge a" and "sourcenode a = n" and "targetnode a = n''"
  and "Vrv S n. state_val s V = state_val s' V"
  and "preds (slice_kinds S (a#as)) s" and "preds (slice_kinds S (a#asx)) s'"
  shows "Vrv S n''. state_val (transfer (slice_kind S a) s) V =
                       state_val (transfer (slice_kind S a) s') V"
proof
  fix V assume "V  rv S n''"
  show "state_val (transfer (slice_kind S a) s) V =
    state_val (transfer (slice_kind S a) s') V"
  proof(cases "V  Def n")
    case True
    show ?thesis
    proof(cases "sourcenode a  backward_slice S")
      case True
      hence "slice_kind S a = kind a" by(rule slice_kind_in_slice)
      with ‹preds (slice_kinds S (a#as)) s have "pred (kind a) s"
        by(simp add:slice_kinds_def)
      from ‹slice_kind S a = kind a ‹preds (slice_kinds S (a#asx)) s'
      have "pred (kind a) s'"
        by(simp add:slice_kinds_def)
      from valid_edge a sourcenode a = n have "n -[]→* n"
        by(fastforce intro:empty_path)
      with True sourcenode a = n have "V  Use n. V  rv S n"
        by(fastforce intro:rvI simp:sourcenodes_def)
      with Vrv S n. state_val s V = state_val s' V sourcenode a = n
      have "V  Use (sourcenode a). state_val s V = state_val s' V" by blast
      from valid_edge a this ‹pred (kind a) s ‹pred (kind a) s'
      have "V  Def (sourcenode a). state_val (transfer (kind a) s) V =
        state_val (transfer (kind a) s') V"
        by(rule CFG_edge_transfer_uses_only_Use)
      with V  Def n sourcenode a = n ‹slice_kind S a = kind a
      show ?thesis by simp
    next
      case False
      from V  rv S n'' obtain xs nx where "n'' -xs→* nx"
        and "nx  backward_slice S" and "V  Use nx"
        and "nx'  set(sourcenodes xs). V  Def nx'" by(erule rvE)
      from valid_edge a sourcenode a = n targetnode a = n'' 
        n'' -xs→* nx
      have "n -a#xs→* nx" by -(rule path.Cons_path)
      with V  Def n V  Use nx nx'  set(sourcenodes xs). V  Def nx'
      have "n influences V in nx" by(fastforce simp:data_dependence_def)
      with nx  backward_slice S have "n  backward_slice S"
        by(rule dd_closed)
      with sourcenode a = n False have False by simp
      thus ?thesis by simp
    qed
  next
    case False
    from V  rv S n'' obtain xs nx where "n'' -xs→* nx"
      and "nx  backward_slice S" and "V  Use nx"
      and "nx'  set(sourcenodes xs). V  Def nx'" by(erule rvE)
    from valid_edge a sourcenode a = n targetnode a = n'' n'' -xs→* nx
    have "n -a#xs→* nx" by -(rule path.Cons_path)
    from False nx'  set(sourcenodes xs). V  Def nx' sourcenode a = n
    have "nx'  set(sourcenodes (a#xs)). V  Def nx'"
      by(simp add:sourcenodes_def)
    with n -a#xs→* nx nx  backward_slice S V  Use nx
    have "V  rv S n" by(rule rvI)
    show ?thesis
    proof(cases "kind a")
      case (Predicate Q)
      show ?thesis
      proof(cases "sourcenode a  backward_slice S")
        case True
        with Predicate have "slice_kind S a = (Q)"
          by(simp add:slice_kind_in_slice)
        with Vrv S n. state_val s V = state_val s' V V  rv S n
        show ?thesis by simp
      next
        case False
        with Predicate obtain Q' where "slice_kind S a = (Q')" 
          by -(erule kind_Predicate_notin_slice_slice_kind_Predicate)
        with Vrv S n. state_val s V = state_val s' V V  rv S n
        show ?thesis by simp
      qed
    next
      case (Update f)
      show ?thesis
      proof(cases "sourcenode a  backward_slice S")
        case True
        hence "slice_kind S a = kind a" by(rule slice_kind_in_slice)
        from Update have "pred (kind a) s" by simp
        with valid_edge a sourcenode a = n V  Def n
        have "state_val (transfer (kind a) s) V = state_val s V"
          by(fastforce intro:CFG_edge_no_Def_equal)
        from Update have "pred (kind a) s'" by simp
        with valid_edge a sourcenode a = n V  Def n
        have "state_val (transfer (kind a) s') V = state_val s' V"
          by(fastforce intro:CFG_edge_no_Def_equal)
        with Vrv S n. state_val s V = state_val s' V V  rv S n
          state_val (transfer (kind a) s) V = state_val s V
          ‹slice_kind S a = kind a
        show ?thesis by fastforce
      next
        case False
        with Update have "slice_kind S a = id" by -(rule slice_kind_Upd)
        with Vrv S n. state_val s V = state_val s' V V  rv S n
        show ?thesis by fastforce
      qed
    qed
  qed
qed



lemma rv_branching_edges_slice_kinds_False:
  assumes "valid_edge a" and "valid_edge ax" 
  and "sourcenode a = n" and "sourcenode ax = n"
  and "targetnode a = n''" and "targetnode ax  n''"
  and "preds (slice_kinds S (a#as)) s" and "preds (slice_kinds S (ax#asx)) s'"
  and "Vrv S n. state_val s V = state_val s' V"
  shows False
proof -
  from valid_edge a valid_edge ax sourcenode a = n sourcenode ax = n
    targetnode a = n'' targetnode ax  n''
  obtain Q Q' where "kind a = (Q)" and "kind ax = (Q')"
    and "s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    by(auto dest:deterministic)
  from valid_edge a valid_edge ax sourcenode a = n sourcenode ax = n
    targetnode a = n'' targetnode ax  n''
  obtain P P' where "slice_kind S a = (P)" 
    and "slice_kind S ax = (P')"
    and "s. (P s  ¬ P' s)  (P' s  ¬ P s)"
    by -(erule slice_deterministic,auto)
  show ?thesis
  proof(cases "sourcenode a  backward_slice S")
    case True
    hence "slice_kind S a = kind a" by(rule slice_kind_in_slice)
    with ‹preds (slice_kinds S (a#as)) s kind a = (Q) 
      ‹slice_kind S a = (P) have "pred (kind a) s"
      by(simp add:slice_kinds_def)
    from True sourcenode a = n sourcenode ax = n
    have "slice_kind S ax = kind ax" by(fastforce simp:slice_kind_in_slice)
    with ‹preds (slice_kinds S (ax#asx)) s' kind ax = (Q')
      ‹slice_kind S ax = (P') have "pred (kind ax) s'" 
      by(simp add:slice_kinds_def)
    with kind ax = (Q') have "Q' s'" by simp
    from valid_edge a sourcenode a = n have "n -[]→* n"
      by(fastforce intro:empty_path)
    with True sourcenode a = n have "V  Use n. V  rv S n"
      by(fastforce intro:rvI simp:sourcenodes_def)
    with Vrv S n. state_val s V = state_val s' V sourcenode a = n
    have "V  Use (sourcenode a). state_val s V = state_val s' V" by blast
    with valid_edge a ‹pred (kind a) s have "pred (kind a) s'"
      by(rule CFG_edge_Uses_pred_equal)
    with kind a = (Q) have "Q s'" by simp
    with Q' s' s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s) have False by simp
    thus ?thesis by simp
  next
    case False
    with kind a = (Q) ‹slice_kind S a = (P)
    have "P = (λs. False)  P = (λs. True)"
      by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
    with ‹slice_kind S a = (P) ‹preds (slice_kinds S (a#as)) s
    have "P = (λs. True)" by(fastforce simp:slice_kinds_def)
    from kind ax = (Q') ‹slice_kind S ax = (P') 
      sourcenode a = n sourcenode ax = n False
    have "P' = (λs. False)  P' = (λs. True)"
      by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
    with ‹slice_kind S ax = (P') ‹preds (slice_kinds S (ax#asx)) s'
    have "P' = (λs. True)" by(fastforce simp:slice_kinds_def)
    with P = (λs. True) s. (P s  ¬ P' s)  (P' s  ¬ P s)
    have False by blast
    thus ?thesis by simp
  qed
qed



subsection ‹The set WS›

inductive_set WS :: "'node set  (('node × 'state) × ('node × 'state)) set"
for S :: "'node set"
where WSI:"obs n (backward_slice S) = obs n' (backward_slice S); 
            V  rv S n. state_val s V = state_val s' V;
            valid_node n; valid_node n'
   ((n,s),(n',s'))  WS S"


lemma WSD:
  "((n,s),(n',s'))  WS S 
   obs n (backward_slice S) = obs n' (backward_slice S)  
      (V  rv S n. state_val s V = state_val s' V) 
      valid_node n  valid_node n'"
by(auto elim:WS.cases)


lemma WS_silent_move:
  assumes "((n1,s1),(n2,s2))  WS S" and "S,kind  (n1,s1) -aτ (n1',s1')"
  and "obs n1' (backward_slice S)  {}" shows "((n1',s1'),(n2,s2))  WS S"
proof -
  from ((n1,s1),(n2,s2))  WS S have "valid_node n1" and "valid_node n2"
    by(auto dest:WSD)
  from S,kind  (n1,s1) -aτ (n1',s1') have "sourcenode a = n1"
    and "targetnode a = n1'" and "transfer (kind a) s1 = s1'"
    and "n1  backward_slice S" and "valid_edge a" and "pred (kind a) s1"
    by(auto elim:silent_move.cases)
  from targetnode a = n1' valid_edge a have "valid_node n1'"
    by(auto simp:valid_node_def)
  have "(m. obs n1' (backward_slice S) = {m})  obs n1' (backward_slice S) = {}"
    by(rule obs_singleton_disj)
  with ‹obs n1' (backward_slice S)  {} obtain n 
    where "obs n1' (backward_slice S) = {n}" by fastforce
  hence "n  obs n1' (backward_slice S)" by auto
  then obtain as where "n1' -as→* n" 
    and "nx  set(sourcenodes as). nx  (backward_slice S)" 
    and "n  (backward_slice S)" by(erule obsE)
  from n1' -as→* n valid_edge a sourcenode a = n1 targetnode a = n1'
  have "n1 -a#as→* n" by(rule Cons_path)
  moreover
  from nx  set(sourcenodes as). nx  (backward_slice S) sourcenode a = n1
    n1  backward_slice S 
  have "nx  set(sourcenodes (a#as)). nx  (backward_slice S)"
    by(simp add:sourcenodes_def)
  ultimately have "n  obs n1 (backward_slice S)" using n  (backward_slice S) 
    by(rule obs_elem)
  hence "obs n1 (backward_slice S) = {n}" by(rule obs_singleton_element)
  with ‹obs n1' (backward_slice S) = {n} 
  have "obs n1 (backward_slice S) = obs n1' (backward_slice S)"
    by simp
  with ‹valid_node n1 ‹valid_node n1' have "rv S n1 = rv S n1'"
    by(rule closed_eq_obs_eq_rvs)
  from n  obs n1 (backward_slice S) ((n1,s1),(n2,s2))  WS S 
  have "obs n1 (backward_slice S) = obs n2 (backward_slice S)"
    and "V  rv S n1. state_val s1 V = state_val s2 V"
    by(fastforce dest:WSD)+
  from ‹obs n1 (backward_slice S) = obs n2 (backward_slice S)
    ‹obs n1 (backward_slice S) = {n} ‹obs n1' (backward_slice S) = {n} 
  have "obs n1' (backward_slice S) = obs n2 (backward_slice S)" by simp
  have "V  rv S n1'. state_val s1' V = state_val s2 V"
  proof
    fix V assume "V  rv S n1'"
    with rv S n1 = rv S n1' have "V  rv S n1" by simp
    then obtain as n' where "n1 -as→* n'" and "n'  (backward_slice S)"
      and "V  Use n'" and "nx  set(sourcenodes as). V  Def nx"
      by(erule rvE)
    with n1  backward_slice S have "V  Def n1"
      by(auto elim:path.cases simp:sourcenodes_def)
    with valid_edge a sourcenode a = n1 ‹pred (kind a) s1
    have "state_val (transfer (kind a) s1) V = state_val s1 V"
      by(fastforce intro:CFG_edge_no_Def_equal)
    with ‹transfer (kind a) s1 = s1' have "state_val s1' V = state_val s1 V" by simp
    from V  rv S n1 V  rv S n1. state_val s1 V = state_val s2 V
    have "state_val s1 V = state_val s2 V" by simp
    with state_val s1' V = state_val s1 V 
    show "state_val s1' V = state_val s2 V" by simp
  qed
  with ‹obs n1' (backward_slice S) = obs n2 (backward_slice S)
    ‹valid_node n1' ‹valid_node n2 show ?thesis by(fastforce intro:WSI)
qed


lemma WS_silent_moves:
  "S,f  (n1,s1) =asτ (n1',s1'); ((n1,s1),(n2,s2))  WS S; f = kind;
    obs n1' (backward_slice S)  {}
   ((n1',s1'),(n2,s2))  WS S"
proof(induct rule:silent_moves.induct)
  case silent_moves_Nil thus ?case by simp
next
  case (silent_moves_Cons S f n s a n' s' as n'' s'')
  note IH = ((n',s'),(n2,s2))  WS S; f = kind; obs n'' (backward_slice S)  {}
              ((n'',s''),(n2,s2))  WS S
  from S,f  (n',s') =asτ (n'',s'') ‹obs n'' (backward_slice S)  {}
  have "obs n' (backward_slice S)  {}" by(fastforce dest:silent_moves_obs_slice)
  with ((n,s),(n2,s2))  WS S S,f  (n,s) -aτ (n',s') f = kind
  have "((n',s'),(n2,s2))  WS S" by -(rule WS_silent_move,simp+)
  from IH[OF this f = kind ‹obs n'' (backward_slice S)  {}]
  show ?case .
qed



lemma WS_observable_move:
  assumes "((n1,s1),(n2,s2))  WS S" and "S,kind  (n1,s1) -a (n1',s1')"
  obtains as where "((n1',s1'),(n1',transfer (slice_kind S a) s2))  WS S"
  and "S,slice_kind S  (n2,s2) =as@[a] (n1',transfer (slice_kind S a) s2)"
proof(atomize_elim)
  from ((n1,s1),(n2,s2))  WS S have "valid_node n1" by(auto dest:WSD)
  from S,kind  (n1,s1) -a (n1',s1') have [simp]:"n1 = sourcenode a" 
    and [simp]:"n1' = targetnode a" and "pred (kind a) s1"
    and "transfer (kind a) s1 = s1'" and "n1  (backward_slice S)" 
    and "valid_edge a" and "pred (kind a) s1"
    by(auto elim:observable_move.cases)
  from  valid_edge a have "valid_node n1'" by(auto simp:valid_node_def)
  from ‹valid_node n1 n1  (backward_slice S) 
  have "obs n1 (backward_slice S) = {n1}" by(rule n_in_obs)
  with ((n1,s1),(n2,s2))  WS S have "obs n2 (backward_slice S) = {n1}" 
    and "V  rv S n1. state_val s1 V = state_val s2 V" by(auto dest:WSD)
  from ‹valid_node n1 have "n1 -[]→* n1" by(rule empty_path)
  with n1  (backward_slice S) have "V  Use n1. V  rv S n1"
    by(fastforce intro:rvI simp:sourcenodes_def)
  with V  rv S n1. state_val s1 V = state_val s2 V
  have "V  Use n1. state_val s1 V = state_val s2 V" by blast
  with valid_edge a  ‹pred (kind a) s1 have "pred (kind a) s2"
    by(fastforce intro:CFG_edge_Uses_pred_equal)
  with n1  (backward_slice S) have "pred (slice_kind S a) s2"
    by(simp add:slice_kind_in_slice)
  from n1  (backward_slice S) obtain s2' 
    where "transfer (slice_kind S a) s2 = s2'"
    by(simp add:slice_kind_in_slice)
  with ‹pred (slice_kind S a) s2 n1  (backward_slice S) valid_edge a 
  have "S,slice_kind S  (n1,s2) -a (n1',s2')"
    by(fastforce intro:observable_moveI)
  from ‹obs n2 (backward_slice S) = {n1}
  obtain as where "S,slice_kind S  (n2,s2) =asτ (n1,s2)"
    by(erule obs_silent_moves)
  with S,slice_kind S  (n1,s2) -a (n1',s2') 
  have "S,slice_kind S  (n2,s2) =as@[a] (n1',s2')"
    by -(rule observable_moves_snoc)
  have "V  rv S n1'. state_val s1' V = state_val s2' V"
  proof
    fix V assume rv:"V  rv S n1'"
    show "state_val s1' V = state_val s2' V"
    proof(cases "V  Def n1")
      case True
      thus ?thesis
      proof(cases "kind a")
        case (Update f)
        with ‹transfer (kind a) s1 = s1' have "s1' = f s1" by simp
        from Update[THEN sym] n1  (backward_slice S) 
        have "slice_kind S a = f"
          by(fastforce intro:slice_kind_in_slice)
        with ‹transfer (slice_kind S a) s2 = s2' have "s2' = f s2" by simp
        from valid_edge a V  Use n1. state_val s1 V = state_val s2 V
          True Update s1' = f s1 s2' = f s2 show ?thesis
          by(fastforce dest:CFG_edge_transfer_uses_only_Use)
      next
        case (Predicate Q)
        with ‹transfer (kind a) s1 = s1' have "s1' = s1" by simp
        from Predicate[THEN sym] n1  (backward_slice S)
        have "slice_kind S a = (Q)"
          by(fastforce intro:slice_kind_in_slice)
        with ‹transfer (slice_kind S a) s2 = s2' have "s2' = s2" by simp
        with valid_edge a V  Use n1. state_val s1 V = state_val s2 V 
          True Predicate s1' = s1 ‹pred (kind a) s1 ‹pred (kind a) s2
        show ?thesis by(auto dest:CFG_edge_transfer_uses_only_Use)
      qed
    next
      case False
      with valid_edge a ‹transfer (kind a) s1 = s1'[THEN sym] 
        ‹pred (kind a) s1 ‹pred (kind a) s2
      have "state_val s1' V = state_val s1 V"
        by(fastforce intro:CFG_edge_no_Def_equal)
      have "state_val s2' V = state_val s2 V"
      proof(cases "kind a")
        case (Update f)
        with  n1  (backward_slice S) have "slice_kind S a = kind a"
          by(fastforce intro:slice_kind_in_slice)
        with valid_edge a ‹transfer (slice_kind S a) s2 = s2'[THEN sym] 
          False ‹pred (kind a) s2
        show ?thesis by(fastforce intro:CFG_edge_no_Def_equal)
      next
        case (Predicate Q)
        with ‹transfer (slice_kind S a) s2 = s2' have "s2 = s2'"
          by(cases "slice_kind S a",
            auto split:if_split_asm simp:slice_kind_def Let_def)
        thus ?thesis by simp
      qed
      from rv obtain as' nx where "n1' -as'→* nx" 
        and "nx  (backward_slice S)"
        and "V  Use nx" and "nx  set(sourcenodes as'). V  Def nx"
        by(erule rvE)
      from nx  set(sourcenodes as'). V  Def nx False
      have "nx  set(sourcenodes (a#as')). V  Def nx"
        by(auto simp:sourcenodes_def)
      from  valid_edge a n1' -as'→* nx have "n1 -a#as'→* nx"
        by(fastforce intro:Cons_path)
      with nx  (backward_slice S) V  Use nx 
        nx  set(sourcenodes (a#as')). V  Def nx
      have "V  rv S n1" by -(rule rvI)
      with V  rv S n1. state_val s1 V = state_val s2 V 
        state_val s1' V = state_val s1 V state_val s2' V = state_val s2 V
      show ?thesis by fastforce
    qed
  qed
  with ‹valid_node n1' have "((n1',s1'),(n1',s2'))  WS S" by(fastforce intro:WSI)
  with S,slice_kind S  (n2,s2) =as@[a] (n1',s2')
    ‹transfer (slice_kind S a) s2 = s2' 
  show "as. ((n1',s1'),(n1',transfer (slice_kind S a) s2))  WS S 
    S,slice_kind S  (n2,s2) =as@[a] (n1',transfer (slice_kind S a) s2)"
    by blast
qed



definition is_weak_sim :: 
  "(('node × 'state) × ('node × 'state)) set  'node set  bool"
  where "is_weak_sim R S  
  n1 s1 n2 s2 n1' s1' as. ((n1,s1),(n2,s2))  R  S,kind  (n1,s1) =as (n1',s1')
   (n2' s2' as'. ((n1',s1'),(n2',s2'))  R  
                      S,slice_kind S  (n2,s2) =as' (n2',s2'))"


lemma WS_weak_sim:
  assumes "((n1,s1),(n2,s2))  WS S" 
  and "S,kind  (n1,s1) =as (n1',s1')"
  shows "((n1',s1'),(n1',transfer (slice_kind S (last as)) s2))  WS S 
  (as'. S,slice_kind S  (n2,s2) =as'@[last as] 
                             (n1',transfer (slice_kind S (last as)) s2))"
proof -
  from S,kind  (n1,s1) =as (n1',s1') obtain a' as' n' s'
    where "S,kind  (n1,s1) =as'τ (n',s')" 
    and "S,kind  (n',s') -a' (n1',s1')" and "as = as'@[a']"
    by(fastforce elim:observable_moves.cases)
  from S,kind  (n',s') -a' (n1',s1') have "obs n' (backward_slice S) = {n'}"
    by(fastforce elim:observable_move.cases intro!:n_in_obs)
  hence "obs n' (backward_slice S)  {}" by fast
  with S,kind  (n1,s1) =as'τ (n',s') ((n1,s1),(n2,s2))  WS S 
  have "((n',s'),(n2,s2))  WS S"
    by -(rule WS_silent_moves,simp+)
  with S,kind  (n',s') -a' (n1',s1') obtain asx 
    where "((n1',s1'),(n1',transfer (slice_kind S a') s2))  WS S"
    and "S,slice_kind S  (n2,s2) =asx@[a'] 
    (n1',transfer (slice_kind S a') s2)"
    by(fastforce elim:WS_observable_move)
  with as = as'@[a'] show
    "((n1',s1'),(n1',transfer (slice_kind S (last as)) s2))  WS S 
    (as'. S,slice_kind S  (n2,s2) =as'@[last as] 
           (n1',transfer (slice_kind S (last as)) s2))" by simp blast
qed

text ‹The following lemma states the correctness of static intraprocedural slicing:\\
  the simulation WS S› is a desired weak simulation›

theorem WS_is_weak_sim:"is_weak_sim (WS S) S"
by(fastforce dest:WS_weak_sim simp:is_weak_sim_def)


subsection @{term "n -as→* n'"} and transitive closure of 
  @{term "S,f  (n,s) =asτ (n',s')"}

inductive trans_observable_moves :: 
  "'node set  ('edge  'state edge_kind)  'node  'state  'edge list  
  'node  'state  bool" ("_,_  '(_,_') =_⇒* '(_,_')" [51,50,0,0,50,0,0] 51) 

where tom_Nil:
  "S,f  (n,s) =[]⇒* (n,s)"

| tom_Cons:
  "S,f  (n,s) =as (n',s'); S,f  (n',s') =as'⇒* (n'',s'')
   S,f  (n,s) =(last as)#as'⇒* (n'',s'')"


definition slice_edges :: "'node set  'edge list  'edge list"
  where "slice_edges S as  [a  as. sourcenode a  backward_slice S]"


lemma silent_moves_no_slice_edges:
  "S,f  (n,s) =asτ (n',s')  slice_edges S as = []"
by(induct rule:silent_moves.induct,auto elim:silent_move.cases simp:slice_edges_def)


lemma observable_moves_last_slice_edges:
  "S,f  (n,s) =as (n',s')  slice_edges S as = [last as]"
by(induct rule:observable_moves.induct,
   fastforce dest:silent_moves_no_slice_edges elim:observable_move.cases 
            simp:slice_edges_def)


lemma slice_edges_no_nodes_in_slice:
  "slice_edges S as = [] 
   nx  set(sourcenodes as). nx  (backward_slice S)"
proof(induct as)
  case Nil thus ?case by(simp add:slice_edges_def sourcenodes_def)
next
  case (Cons a' as')
  note IH = ‹slice_edges S as' = [] 
    nxset (sourcenodes as'). nx  backward_slice S
  from ‹slice_edges S (a'#as') = [] have "slice_edges S as' = []"
    and "sourcenode a'  backward_slice S"
    by(auto simp:slice_edges_def split:if_split_asm)
  from IH[OF ‹slice_edges S as' = []] sourcenode a'  backward_slice S
  show ?case by(simp add:sourcenodes_def)
qed



lemma sliced_path_determ:
  "n -as→* n'; n -as'→* n'; slice_edges S as = slice_edges S as';
    preds (slice_kinds S as) s; preds (slice_kinds S as') s'; n'  S;
    V  rv S n. state_val s V = state_val s' V  as = as'"
proof(induct arbitrary:as' s s' rule:path.induct)
  case (empty_path n)
  from ‹slice_edges S [] = slice_edges S as' 
  have "nx  set(sourcenodes as'). nx  (backward_slice S)"
    by(fastforce intro!:slice_edges_no_nodes_in_slice simp:slice_edges_def)
  with n -as'→* n show ?case
  proof(induct nx"n" as' nx'"n" rule:path.induct)
    case (Cons_path n'' as a)
    from ‹valid_node n n  S have "n  backward_slice S" by(rule refl)
    with nxset (sourcenodes (a # as)). nx  backward_slice S 
      sourcenode a = n
    have False by(simp add:sourcenodes_def)
    thus ?case by simp
  qed simp
next
  case (Cons_path n'' as n' a n)
  note IH = as' s s'. n'' -as'→* n'; slice_edges S as = slice_edges S as';
    preds (slice_kinds S as) s; preds (slice_kinds S as') s'; n'  S;
    Vrv S n''. state_val s V = state_val s' V  as = as'
  show ?case
  proof(cases as')
    case Nil
    with n -as'→* n' have "n = n'" by fastforce
    from Nil ‹slice_edges S (a#as) = slice_edges S as' sourcenode a = n
    have "n  backward_slice S" by(fastforce simp:slice_edges_def)
    from valid_edge a sourcenode a = n n = n' n'  S
    have "n  backward_slice S" by(fastforce intro:refl)
    with n = n' n  backward_slice S have False by simp
    thus ?thesis by simp
  next
    case (Cons ax asx)
    with n -as'→* n' have "n = sourcenode ax" and "valid_edge ax" 
      and "targetnode ax -asx→* n'" by(auto elim:path_split_Cons)
    show ?thesis
    proof(cases "targetnode ax = n''")
      case True
      with targetnode ax -asx→* n' have "n'' -asx→* n'" by simp
      from valid_edge ax valid_edge a n = sourcenode ax sourcenode a = n
        True targetnode a = n'' have "ax = a" by(fastforce intro:edge_det)
      from ‹slice_edges S (a#as) = slice_edges S as' Cons 
        n = sourcenode ax sourcenode a = n
      have "slice_edges S as = slice_edges S asx"
        by(cases "n  backward_slice S")(auto simp:slice_edges_def)
      from ‹preds (slice_kinds S (a#as)) s 
      have preds1:"preds (slice_kinds S as) (transfer (slice_kind S a) s)"
        by(simp add:slice_kinds_def)
      from ‹preds (slice_kinds S as') s' Cons ax = a
      have preds2:"preds (slice_kinds S asx) (transfer (slice_kind S a) s')"
        by(simp add:slice_kinds_def)
      from valid_edge a sourcenode a = n targetnode a = n''
        ‹preds (slice_kinds S (a#as)) s ‹preds (slice_kinds S as') s'
        ax = a Cons Vrv S n. state_val s V = state_val s' V
      have "Vrv S n''. state_val (transfer (slice_kind S a) s) V =
                          state_val (transfer (slice_kind S a) s') V"
        by -(rule rv_edge_slice_kinds,auto)
      from IH[OF n'' -asx→* n' ‹slice_edges S as = slice_edges S asx
        preds1 preds2 n'  S this] Cons ax = a show ?thesis by simp
    next
      case False
      with valid_edge a valid_edge ax sourcenode a = n n = sourcenode ax
        targetnode a = n'' ‹preds (slice_kinds S (a#as)) s
        ‹preds (slice_kinds S as') s' Cons
        Vrv S n. state_val s V = state_val s' V
      have False by -(erule rv_branching_edges_slice_kinds_False,auto)
      thus ?thesis by simp
    qed
  qed
qed



lemma path_trans_observable_moves:
  assumes "n -as→* n'" and "preds (kinds as) s" and "transfers (kinds as) s = s'"
  obtains n'' s'' as' as'' where "S,kind  (n,s) =slice_edges S as⇒* (n'',s'')"
  and "S,kind  (n'',s'') =as'τ (n',s')" 
  and "slice_edges S as = slice_edges S as''" and "n -as''@as'→* n'"
proof(atomize_elim)
  from n -as→* n' ‹preds (kinds as) s ‹transfers (kinds as) s = s'
  show "n'' s'' as' as''. 
    S,kind  (n,s) =slice_edges S as⇒* (n'',s'') 
    S,kind  (n'',s'') =as'τ (n',s')  slice_edges S as = slice_edges S as'' 
    n -as''@as'→* n'"
  proof(induct arbitrary:s rule:path.induct)
    case (empty_path n)
    from ‹transfers (kinds []) s = s' have "s = s'" by(simp add:kinds_def)
    have "S,kind  (n,s) =[]⇒* (n,s)" by(rule tom_Nil)
    have "S,kind  (n,s) =[]τ (n,s)" by(rule silent_moves_Nil)
    with S,kind  (n,s) =[]⇒* (n,s) s = s' ‹valid_node n
    show ?case
      apply(rule_tac x="n" in exI)
      apply(rule_tac x="s" in exI)
      apply(rule_tac x="[]" in exI)
      apply(rule_tac x="[]" in exI)
      by(fastforce intro:path.empty_path simp:slice_edges_def)
  next
    case (Cons_path n'' as n' a n)
    note IH = s. preds (kinds as) s; transfers (kinds as) s = s'
       nx s'' as' as''. S,kind  (n'',s) =slice_edges S as⇒* (nx,s'') 
            S,kind  (nx,s'') =as'τ (n',s')  
            slice_edges S as = slice_edges S as''  n'' -as''@as'→* n'
    from ‹preds (kinds (a#as)) s ‹transfers (kinds (a#as)) s = s'
    have "preds (kinds as) (transfer (kind a) s)" 
      "transfers (kinds as) (transfer (kind a) s) = s'" by(simp_all add:kinds_def)
    from IH[OF this] obtain nx sx asx asx'
      where "S,kind  (n'',transfer (kind a) s) =slice_edges S as⇒* (nx,sx)"
      and "S,kind  (nx,sx) =asxτ (n',s')"
      and "slice_edges S as = slice_edges S asx'"
      and "n'' -asx'@asx→* n'"
      by clarsimp
    from ‹preds (kinds (a#as)) s have "pred (kind a) s" by(simp add:kinds_def)
    show ?case
    proof(cases "n  backward_slice S")
      case True
      with valid_edge a sourcenode a = n targetnode a = n'' ‹pred (kind a) s
      have "S,kind  (n,s) -a (n'',transfer (kind a) s)"
        by(fastforce intro:observable_moveI)
      hence "S,kind  (n,s) =[]@[a] (n'',transfer (kind a) s)"
        by(fastforce intro:observable_moves_snoc silent_moves_Nil)
      with S,kind  (n'',transfer (kind a) s) =slice_edges S as⇒* (nx,sx)
      have "S,kind  (n,s) =a#slice_edges S as⇒* (nx,sx)"
        by(fastforce dest:tom_Cons)
      with S,kind  (nx,sx) =asxτ (n',s')
        ‹slice_edges S as = slice_edges S asx' n'' -asx'@asx→* n'
        sourcenode a = n valid_edge a targetnode a = n'' True
      show ?thesis
        apply(rule_tac x="nx" in exI)
        apply(rule_tac x="sx" in exI)
        apply(rule_tac x="asx" in exI)
        apply(rule_tac x="a#asx'" in exI)
        by(auto intro:path.Cons_path simp:slice_edges_def)
    next
      case False
      with valid_edge a sourcenode a = n targetnode a = n'' ‹pred (kind a) s
      have "S,kind  (n,s) -aτ (n'',transfer (kind a) s)"
        by(fastforce intro:silent_moveI)
      from S,kind  (n'',transfer (kind a) s) =slice_edges S as⇒* (nx,sx)
      obtain f s'' asx'' where "S,f  (n'',s'') =asx''⇒* (nx,sx)"
        and "f = kind" and "s'' = transfer (kind a) s" 
        and "asx'' = slice_edges S as" by simp
      from S,f  (n'',s'') =asx''⇒* (nx,sx) f = kind
        asx'' = slice_edges S as s'' = transfer (kind a) s
        S,kind  (n,s) -aτ (n'',transfer (kind a) s) 
        S,kind  (nx,sx) =asxτ (n',s') ‹slice_edges S as = slice_edges S asx'
        n'' -asx'@asx→* n' False
      show ?thesis
      proof(induct rule:trans_observable_moves.induct)
        case (tom_Nil S f ni si)
        have "S,kind  (n,s) =[]⇒* (n,s)" by(rule trans_observable_moves.tom_Nil)
        from S,kind  (ni,si) =asxτ (n',s')
          S,kind  (n,s) -aτ (ni,transfer (kind a) s) 
          si = transfer (kind a) s
        have "S,kind  (n,s) =a#asxτ (n',s')"
          by(fastforce intro:silent_moves_Cons)
        with valid_edge a sourcenode a = n
        have "n -a#asx→* n'" by(fastforce dest:silent_moves_preds_transfers_path)
        with sourcenode a = n valid_edge a targetnode a = n''
          [] = slice_edges S as n  backward_slice S
          S,kind  (n,s) =a#asxτ (n',s')
        show ?case
          apply(rule_tac x="n" in exI)
          apply(rule_tac x="s" in exI)
          apply(rule_tac x="a#asx" in exI)
          apply(rule_tac x="[]" in exI)
          by(fastforce simp:slice_edges_def intro:trans_observable_moves.tom_Nil)
      next
        case (tom_Cons S f ni si asi ni' si' asi' n'' s'')
        from S,f  (ni,si) =asi (ni',si') have "asi  []"
          by(fastforce dest:observable_move_notempty)
        from S,kind  (n,s) -aτ (ni,transfer (kind a) s)
        have "valid_edge a" and "sourcenode a = n" and "targetnode a = ni"
          by(auto elim:silent_move.cases)
        from S,kind  (n,s) -aτ (ni,transfer (kind a) s) f = kind
          si = transfer (kind a) s S,f  (ni,si) =asi (ni',si')
        have "S,f  (n,s) =a#asi (ni',si')"
          by(fastforce intro:silent_move_observable_moves)
        with S,f  (ni',si') =asi'⇒* (n'',s'')
        have "S,f  (n,s) =(last (a#asi))#asi'⇒* (n'',s'')"
          by -(rule trans_observable_moves.tom_Cons)
        with f = kind ‹last asi # asi' = slice_edges S as n  backward_slice S
          S,kind  (n'',s'') =asxτ (n',s')  sourcenode a = n asi  []
          ni -asx'@asx→* n' ‹slice_edges S as = slice_edges S asx'
          valid_edge a sourcenode a = n targetnode a = ni
        show ?case
          apply(rule_tac x="n''" in exI)
          apply(rule_tac x="s''" in exI)
          apply(rule_tac x="asx" in exI)
          apply(rule_tac x="a#asx'" in exI)
          by(auto intro:path.Cons_path simp:slice_edges_def)
      qed
    qed
  qed
qed


lemma WS_weak_sim_trans:
  assumes "((n1,s1),(n2,s2))  WS S"
  and "S,kind  (n1,s1) =as⇒* (n1',s1')" and "as  []"
  shows "((n1',s1'),(n1',transfers (slice_kinds S as) s2))  WS S  
         S,slice_kind S  (n2,s2) =as⇒* (n1',transfers (slice_kinds S as) s2)"
proof -
  obtain f where "f = kind" by simp
  with S,kind  (n1,s1) =as⇒* (n1',s1') 
  have "S,f  (n1,s1) =as⇒* (n1',s1')" by simp
  from S,f  (n1,s1) =as⇒* (n1',s1') ((n1,s1),(n2,s2))  WS S as  [] f = kind
  show "((n1',s1'),(n1',transfers (slice_kinds S as) s2))  WS S 
    S,slice_kind S  (n2,s2) =as⇒* (n1',transfers (slice_kinds S as) s2)"
  proof(induct arbitrary:n2 s2 rule:trans_observable_moves.induct)
    case tom_Nil thus ?case by simp
  next
    case (tom_Cons S f n s as n' s' as' n'' s'')
    note IH = n2 s2. ((n',s'),(n2,s2))  WS S; as'  []; f = kind
       ((n'',s''),(n'',transfers (slice_kinds S as') s2))  WS S 
      S,slice_kind S  (n2,s2) =as'⇒* (n'',transfers (slice_kinds S as') s2)
    from S,f  (n,s) =as (n',s')
    obtain asx ax nx sx where "S,f  (n,s) =asxτ (nx,sx)"
      and "S,f  (nx,sx) -ax (n',s')" and "as = asx@[ax]"
      by(fastforce elim:observable_moves.cases)
    from S,f  (nx,sx) -ax (n',s') have "obs nx (backward_slice S) = {nx}"
      by(fastforce intro!:n_in_obs elim:observable_move.cases)
    with S,f  (n,s) =asxτ (nx,sx) ((n,s),(n2,s2))  WS S f = kind
    have "((nx,sx),(n2,s2))  WS S" by(fastforce intro:WS_silent_moves)
    with S,f  (nx,sx) -ax (n',s') f = kind
    obtain asx' where "((n',s'),(n',transfer (slice_kind S ax) s2))  WS S"
      and "S,slice_kind S  (n2,s2) =asx'@[ax] 
      (n',transfer (slice_kind S ax) s2)"
      by(fastforce elim:WS_observable_move)
    show ?case
    proof(cases "as' = []")
      case True
      with S,f  (n',s') =as'⇒* (n'',s'') have "n' = n''  s' = s''"
        by(fastforce elim:trans_observable_moves.cases dest:observable_move_notempty)
      from S,slice_kind S  (n2,s2) =asx'@[ax] 
                               (n',transfer (slice_kind S ax) s2)
      have "S,slice_kind S  (n2,s2) =(last (asx'@[ax]))#[]⇒* 
                               (n',transfer (slice_kind S ax) s2)"
        by(fastforce intro:trans_observable_moves.intros)
      with ((n',s'),(n',transfer (slice_kind S ax) s2))  WS S as = asx@[ax]
        n' = n''  s' = s'' True
      show ?thesis by(fastforce simp:slice_kinds_def)
    next
      case False
      from IH[OF ((n',s'),(n',transfer (slice_kind S ax) s2))  WS S this 
        f = kind]
      have "((n'',s''),(n'',transfers (slice_kinds S as') 
        (transfer (slice_kind S ax) s2)))  WS S"
        and "S,slice_kind S  (n',transfer (slice_kind S ax) s2) 
        =as'⇒* (n'',transfers (slice_kinds S as')
                     (transfer (slice_kind S ax) s2))" by simp_all
      with S,slice_kind S  (n2,s2) =asx'@[ax] 
                               (n',transfer (slice_kind S ax) s2)
      have "S,slice_kind S  (n2,s2) =(last (asx'@[ax]))#as'⇒* 
        (n'',transfers (slice_kinds S as') (transfer (slice_kind S ax) s2))"
        by(fastforce intro:trans_observable_moves.tom_Cons)
      with ((n'',s''),(n'',transfers (slice_kinds S as') 
        (transfer (slice_kind S ax) s2)))  WS S False as = asx@[ax]
      show ?thesis by(fastforce simp:slice_kinds_def)
    qed
  qed
qed


lemma transfers_slice_kinds_slice_edges:
  "transfers (slice_kinds S (slice_edges S as)) s = transfers (slice_kinds S as) s"
proof(induct as arbitrary:s)
  case Nil thus ?case by(simp add:slice_kinds_def slice_edges_def)
next
  case (Cons a' as')
  note IH = s. transfers (slice_kinds S (slice_edges S as')) s =
                  transfers (slice_kinds S as') s
  show ?case
  proof(cases "sourcenode a'  backward_slice S")
    case True
    hence eq:"transfers (slice_kinds S (slice_edges S (a'#as'))) s
            = transfers (slice_kinds S (slice_edges S as')) 
                (transfer (slice_kind S a') s)"
      by(simp add:slice_edges_def slice_kinds_def)
    have "transfers (slice_kinds S (a'#as')) s
        = transfers (slice_kinds S as') (transfer (slice_kind S a') s)"
      by(simp add:slice_kinds_def)
    with eq IH[of "transfer (slice_kind S a') s"] show ?thesis by simp
  next
    case False
    hence eq:"transfers (slice_kinds S (slice_edges S (a'#as'))) s
            = transfers (slice_kinds S (slice_edges S as')) s"
      by(simp add:slice_edges_def slice_kinds_def)
    from False have "transfer (slice_kind S a') s = s"
      by(cases "kind a'",auto simp:slice_kind_def Let_def)
    hence "transfers (slice_kinds S (a'#as')) s
         = transfers (slice_kinds S as') s"
      by(simp add:slice_kinds_def)
    with eq IH[of s] show ?thesis by simp
  qed
qed


lemma trans_observable_moves_preds:
  assumes "S,f  (n,s) =as⇒* (n',s')" and "valid_node n"
  obtains as' where "preds (map f as') s" and "slice_edges S as' = as"
  and "n -as'→* n'"
proof(atomize_elim)
  from S,f  (n,s) =as⇒* (n',s') ‹valid_node n
  show "as'. preds (map f as') s  slice_edges S as' = as  n -as'→* n'"
  proof(induct rule:trans_observable_moves.induct)
    case tom_Nil thus ?case 
      by(rule_tac x="[]" in exI,fastforce intro:empty_path simp:slice_edges_def)
  next
    case (tom_Cons S f n s as n' s' as' n'' s'')
    note IH = ‹valid_node n' 
       asx. preds (map f asx) s'  slice_edges S asx = as'  n' -asx→* n''
    from S,f  (n,s) =as (n',s')
    have "preds (map f as) s" and "transfers (map f as) s = s'"
      and "n -as→* n'"
      by(fastforce dest:observable_moves_preds_transfers_path)+
    from n -as→* n' have "valid_node n'" by(fastforce dest:path_valid_node)
    from S,f  (n,s) =as (n',s') have "slice_edges S as = [last as]"
      by(rule observable_moves_last_slice_edges)
    from IH[OF ‹valid_node n']
    obtain asx where "preds (map f asx) s'" and "slice_edges S asx = as'"
      and "n' -asx→* n''"
      by blast
    from n -as→* n' n' -asx→* n'' have "n -as@asx→* n''" by(rule path_Append)
    from ‹preds (map f asx) s' ‹transfers (map f as) s = s'[THEN sym]
      ‹preds (map f as) s
    have "preds (map f (as@asx)) s" by(simp add:preds_split)
    with ‹slice_edges S as = [last as] ‹slice_edges S asx = as' 
      n -as@asx→* n'' show ?case
      by(rule_tac x="as@asx" in exI,auto simp:slice_edges_def)
  qed
qed



lemma exists_sliced_path_preds:
  assumes "n -as→* n'" and "slice_edges S as = []" and "n'  backward_slice S"
  obtains as' where "n -as'→* n'" and "preds (slice_kinds S as') s"
  and "slice_edges S as' = []"
proof(atomize_elim)
  from ‹slice_edges S as = []
  have "nx  set(sourcenodes as). nx  (backward_slice S)"
    by(rule slice_edges_no_nodes_in_slice)
  with n -as→* n' n'  backward_slice S have "n'  obs n (backward_slice S)"
    by -(rule obs_elem)
  hence "obs n (backward_slice S) = {n'}" by(rule obs_singleton_element)
  from n -as→* n' have "valid_node n" and "valid_node n'"
    by(fastforce dest:path_valid_node)+
  from n -as→* n' obtain x where "distance n n' x" and "x  length as"
    by(erule every_path_distance)
  from ‹distance n n' x ‹obs n (backward_slice S) = {n'}
  show "as'. n -as'→* n'  preds (slice_kinds S as') s  
              slice_edges S as' = []"
  proof(induct x arbitrary:n rule:nat.induct)
    case zero
    from ‹distance n n' 0 have "n = n'" by(fastforce elim:distance.cases)
    with ‹valid_node n' show ?case
      by(rule_tac x="[]" in exI,
        auto intro:empty_path simp:slice_kinds_def slice_edges_def)
  next
    case (Suc x)
    note IH = n. distance n n' x; obs n (backward_slice S) = {n'}
       as'. n -as'→* n'  preds (slice_kinds S as') s  
               slice_edges S as' = []
    from ‹distance n n' (Suc x) obtain a 
      where "valid_edge a" and "n = sourcenode a" 
      and "distance (targetnode a) n' x"
      and target:"targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
      distance (targetnode a') n' x 
      valid_edge a'  targetnode a' = nx)"
      by(auto elim:distance_successor_distance)
    have "n  backward_slice S"
    proof
      assume "n  backward_slice S"
      from valid_edge a n = sourcenode a have "valid_node n" by simp
      with n  backward_slice S have "obs n (backward_slice S) = {n}"
        by -(rule n_in_obs)
      with ‹obs n (backward_slice S) = {n'} have "n = n'" by simp
      with ‹valid_node n have "n -[]→* n'" by(fastforce intro:empty_path)
      with ‹distance n n' (Suc x) show False
        by(fastforce elim:distance.cases)
    qed
    from ‹distance (targetnode a) n' x n'  backward_slice S
    obtain m where "m  obs (targetnode a) (backward_slice S)"
      by(fastforce elim:distance.cases path_ex_obs)
    from valid_edge a n  backward_slice S n = sourcenode a
    have "obs (targetnode a) (backward_slice S)  
      obs (sourcenode a) (backward_slice S)"
      by -(rule edge_obs_subset,auto)
    with m  obs (targetnode a) (backward_slice S) n = sourcenode a
      ‹obs n (backward_slice S) = {n'}
    have "n'  obs (targetnode a) (backward_slice S)" by auto
    hence "obs (targetnode a) (backward_slice S) = {n'}" 
      by(rule obs_singleton_element)
    from IH[OF ‹distance (targetnode a) n' x this]
    obtain as where "targetnode a -as→* n'" and "preds (slice_kinds S as) s"
      and "slice_edges S as = []" by blast
    from targetnode a -as→* n' valid_edge a n = sourcenode a
    have "n -a#as→* n'" by(fastforce intro:Cons_path)
    from ‹slice_edges S as = [] n  backward_slice S n = sourcenode a
    have "slice_edges S (a#as) = []" by(simp add:slice_edges_def)
    show ?case
    proof(cases "kind a")
      case (Update f)
      with n  backward_slice S n = sourcenode a have "slice_kind S a = id"
        by(fastforce intro:slice_kind_Upd)
      hence "transfer (slice_kind S a) s = s" and "pred (slice_kind S a) s"
        by simp_all
      with ‹preds (slice_kinds S as) s have "preds (slice_kinds S (a#as)) s"
        by(simp add:slice_kinds_def)
      with n -a#as→* n' ‹slice_edges S (a#as) = [] show ?thesis
        by blast
    next
      case (Predicate Q)
      with n  backward_slice S n = sourcenode a ‹distance n n' (Suc x)  
        ‹obs n (backward_slice S) = {n'} ‹distance (targetnode a) n' x
        targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
        distance (targetnode a') n' x 
        valid_edge a'  targetnode a' = nx)
      have "slice_kind S a = (λs. True)"
        by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
      hence "transfer (slice_kind S a) s = s" and "pred (slice_kind S a) s"
        by simp_all
      with ‹preds (slice_kinds S as) s have "preds (slice_kinds S (a#as)) s"
        by(simp add:slice_kinds_def)
      with n -a#as→* n' ‹slice_edges S (a#as) = [] show ?thesis by blast
    qed
  qed
qed


theorem fundamental_property_of_static_slicing:
  assumes path:"n -as→* n'" and preds:"preds (kinds as) s" and "n'  S"
  obtains as' where "preds (slice_kinds S as') s"
  and "(V  Use n'. state_val (transfers (slice_kinds S as') s) V = 
                     state_val (transfers (kinds as) s) V)"
  and "slice_edges S as = slice_edges S as'" and "n -as'→* n'"
proof(atomize_elim)
  from path preds obtain n'' s'' as' as''
    where "S,kind  (n,s) =slice_edges S as⇒* (n'',s'')"
    and "S,kind  (n'',s'') =as'τ (n',transfers (kinds as) s)"
    and "slice_edges S as = slice_edges S as''"
    and "n -as''@as'→* n'"
    by -(erule_tac S="S" in path_trans_observable_moves,auto)
  from path have "valid_node n" and "valid_node n'" 
    by(fastforce dest:path_valid_node)+
  from ‹valid_node n have "((n,s),(n,s))  WS S" by(fastforce intro:WSI)
  from ‹valid_node n' n'  S have "obs n' (backward_slice S) = {n'}"
    by(fastforce intro!:n_in_obs refl)
  from ‹valid_node n' have "n'-[]→* n'" by(fastforce intro:empty_path)
  with ‹valid_node n' n'  S have "V  Use n'. V  rv S n'"
    by(fastforce intro:rvI refl simp:sourcenodes_def)
  show "as'. preds (slice_kinds S as') s 
    (V  Use n'. state_val (transfers (slice_kinds S as') s) V = 
                  state_val (transfers (kinds as) s) V) 
    slice_edges S as = slice_edges S as'  n -as'→* n'"
  proof(cases "slice_edges S as = []")
    case True
    hence "preds (slice_kinds S []) s" and "slice_edges S [] = slice_edges S as"
      by(simp_all add:slice_kinds_def slice_edges_def)
    from S,kind  (n,s) =slice_edges S as⇒* (n'',s'') True
    have "n = n''" and "s = s''"
      by(fastforce elim:trans_observable_moves.cases)+
    with S,kind  (n'',s'') =as'τ (n',transfers (kinds as) s)
    have "S,kind  (n,s) =as'τ (n',transfers (kinds as) s)" by simp
    with ‹valid_node n have "n -as'→* n'"
      by(fastforce dest:silent_moves_preds_transfers_path)
    from S,kind  (n,s) =as'τ (n',transfers (kinds as) s)
    have "slice_edges S as' = []" by(fastforce dest:silent_moves_no_slice_edges)
    with n -as'→* n' ‹valid_node n' n'  S obtain asx
      where "n -asx→* n'" and "preds (slice_kinds S asx) s"
      and "slice_edges S asx = []"
      by -(erule exists_sliced_path_preds,auto intro:refl)
    from S,kind  (n,s) =as'τ (n',transfers (kinds as) s)
      ((n,s),(n,s))  WS S ‹obs n' (backward_slice S) = {n'}
    have "((n',transfers (kinds as) s),(n,s))  WS S"
      by(fastforce intro:WS_silent_moves)
    with True have "V  rv S n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (slice_edges S as)) s) V"
      by(fastforce dest:WSD simp:slice_edges_def slice_kinds_def)
    with V  Use n'. V  rv S n'
    have "V  Use n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (slice_edges S as)) s) V" by simp
    with ‹slice_edges S asx = [] ‹slice_edges S [] = slice_edges S as
    have "V  Use n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (slice_edges S asx)) s) V"
      by(simp add:slice_edges_def)
    hence "V  Use n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S asx) s) V"
      by(simp add:transfers_slice_kinds_slice_edges)
    with n -asx→* n' ‹preds (slice_kinds S asx) s
      ‹slice_edges S asx = [] ‹slice_edges S [] = slice_edges S as
    show ?thesis
      by(rule_tac x="asx" in exI,simp add:slice_edges_def)
  next
    case False
    with S,kind  (n,s) =slice_edges S as⇒* (n'',s'') ((n,s),(n,s))  WS S
    have "((n'',s''),(n'',transfers (slice_kinds S (slice_edges S as)) s))  WS S"
      "S,slice_kind S  (n,s) =slice_edges S as⇒* 
      (n'',transfers (slice_kinds S (slice_edges S as)) s)"
      by(fastforce dest:WS_weak_sim_trans)+
    from S,slice_kind S  (n,s) =slice_edges S as⇒* 
                             (n'',transfers (slice_kinds S (slice_edges S as)) s)
      ‹valid_node n
    obtain asx where "preds (slice_kinds S asx) s" 
      and "slice_edges S asx = slice_edges S as"
      and "n -asx→* n''"
      by(fastforce elim:trans_observable_moves_preds simp:slice_kinds_def)
    from n -asx→* n'' have "valid_node n''" by(fastforce dest:path_valid_node)
    with S,kind  (n'',s'') =as'τ (n',transfers (kinds as) s)
    have "n'' -as'→* n'"
      by(fastforce dest:silent_moves_preds_transfers_path)
    from S,kind  (n'',s'') =as'τ (n',transfers (kinds as) s)
    have "slice_edges S as' = []" by(fastforce dest:silent_moves_no_slice_edges)
    with n'' -as'→* n' ‹valid_node n' n'  S obtain asx'
      where "n'' -asx'→* n'" and "slice_edges S asx' = []"
      and "preds (slice_kinds S asx') (transfers (slice_kinds S asx) s)"
      by -(erule exists_sliced_path_preds,auto intro:refl)
    from n -asx→* n'' n'' -asx'→* n' have "n -asx@asx'→* n'"
      by(rule path_Append)
    from ‹slice_edges S asx = slice_edges S as ‹slice_edges S asx' = []
    have "slice_edges S as = slice_edges S (asx@asx')"
      by(auto simp:slice_edges_def)
    from ‹preds (slice_kinds S asx') (transfers (slice_kinds S asx) s)
      ‹preds (slice_kinds S asx) s
    have "preds (slice_kinds S (asx@asx')) s" 
      by(simp add:slice_kinds_def preds_split)
    from ‹obs n' (backward_slice S) = {n'}
      S,kind  (n'',s'') =as'τ (n',transfers (kinds as) s)
      ((n'',s''),(n'',transfers (slice_kinds S (slice_edges S as)) s))  WS S
    have "((n',transfers (kinds as) s),
      (n'',transfers (slice_kinds S (slice_edges S as)) s))  WS S"
      by(fastforce intro:WS_silent_moves)
    hence "V  rv S n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (slice_edges S as)) s) V"
      by(fastforce dest:WSD)
    with V  Use n'. V  rv S n' ‹slice_edges S asx = slice_edges S as
    have "V  Use n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (slice_edges S asx)) s) V"
      by fastforce
    with ‹slice_edges S asx' = []
    have "V  Use n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (slice_edges S (asx@asx'))) s) V"
      by(auto simp:slice_edges_def)
    hence "V  Use n'. state_val (transfers (kinds as) s) V = 
      state_val (transfers (slice_kinds S (asx@asx')) s) V"
      by(simp add:transfers_slice_kinds_slice_edges)
    with ‹preds (slice_kinds S (asx@asx')) s n -asx@asx'→* n'
      ‹slice_edges S as = slice_edges S (asx@asx')
    show ?thesis by simp blast
  qed
qed


end


subsection ‹The fundamental property of (static) slicing related to the semantics›

locale BackwardSlice_wf = 
  BackwardSlice sourcenode targetnode kind valid_edge Entry Def Use state_val 
  backward_slice +
  CFG_semantics_wf sourcenode targetnode kind valid_edge Entry sem identifies
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and backward_slice :: "'node set  'node set" 
  and sem :: "'com  'state  'com  'state  bool" 
    ("((1_,/_) / (1_,/_))" [0,0,0,0] 81)
  and identifies :: "'node  'com  bool" ("_  _" [51, 0] 80)

begin


theorem fundamental_property_of_path_slicing_semantically:
  assumes "n  c" and "c,s  c',s'"
  obtains n' as where "n -as→* n'" and "preds (slice_kinds {n'} as) s" and "n'  c'"
  and "V  Use n'. state_val (transfers (slice_kinds {n'} as) s) V = state_val s' V"
proof(atomize_elim)
  from n  c c,s  c',s' obtain n' as where "n -as→* n'"
    and "transfers (kinds as) s = s'" and "preds (kinds as) s" and "n'  c'"
    by(fastforce dest:fundamental_property)
  from n -as→* n' ‹preds (kinds as) s obtain as'
    where "preds (slice_kinds {n'} as') s"
    and vals:"V  Use n'. state_val (transfers (slice_kinds {n'} as') s) V = 
    state_val (transfers (kinds as) s) V" and "n -as'→* n'"
    by -(erule fundamental_property_of_static_slicing,auto)
  from ‹transfers (kinds as) s = s' vals have "V  Use n'.
    state_val (transfers (slice_kinds {n'} as') s) V = state_val s' V"
    by simp
  with ‹preds (slice_kinds {n'} as') s n -as'→* n' n'  c'
  show "as n'. n -as→* n'  preds (slice_kinds {n'} as) s  n'  c' 
    (VUse n'. state_val (transfers (slice_kinds {n'} as) s) V = state_val s' V)"
    by blast
qed


end

end

Theory StandardControlDependence

section ‹Static Standard Control Dependence›

theory StandardControlDependence imports 
  "../Basic/Postdomination" 
  "../Basic/DynStandardControlDependence"
begin

context Postdomination begin

subsubsection ‹Definition and some lemmas›

definition standard_control_dependence :: "'node  'node  bool" 
  ("_ controlss _" [51,0])
where standard_control_dependences_eq:"n controlss n'  as. n controlss n' via as"

lemma standard_control_dependence_def:"n controlss n' =
    (a a' as. (n'  set(sourcenodes (a#as)))  (n -a#as→* n') 
                   (n' postdominates (targetnode a)) 
                   (valid_edge a')  (sourcenode a' = n)  
                   (¬ n' postdominates (targetnode a')))"
by(auto simp:standard_control_dependences_eq dyn_standard_control_dependence_def)


lemma Exit_not_standard_control_dependent:
  "n controlss (_Exit_)  False"
by(auto simp:standard_control_dependences_eq 
        intro:Exit_not_dyn_standard_control_dependent)
             

lemma standard_control_dependence_def_variant:
  "n controlss n' = (as. (n -as→* n')  (n  n') 
    (¬ n' postdominates n)  (n'  set(sourcenodes as)) 
  (n''  set(targetnodes as). n' postdominates n''))"
by(auto simp:standard_control_dependences_eq 
             dyn_standard_control_dependence_def_variant)


lemma inner_node_standard_control_dependence_predecessor:
  assumes "inner_node n" "(_Entry_) -as→* n" "n -as'→* (_Exit_)"
  obtains n' where "n' controlss n"
using assms
by(auto elim!:inner_node_dyn_standard_control_dependence_predecessor
        simp:standard_control_dependences_eq)

end

end

Theory WeakControlDependence

section ‹Static Weak Control Dependence›

theory WeakControlDependence imports 
  "../Basic/Postdomination" 
  "../Basic/DynWeakControlDependence"
begin

context StrongPostdomination begin

definition 
  weak_control_dependence :: "'node  'node  bool" 
  ("_ weakly controls _" [51,0])
where weak_control_dependences_eq:
    "n weakly controls n'  as. n weakly controls n' via as"

lemma 
  weak_control_dependence_def:"n weakly controls n' = 
    (a a' as. (n'  set(sourcenodes (a#as)))  (n -a#as→* n') 
                   (n' strongly-postdominates (targetnode a)) 
                   (valid_edge a')  (sourcenode a' = n)  
                   (¬ n' strongly-postdominates (targetnode a')))"
by(auto simp:weak_control_dependences_eq dyn_weak_control_dependence_def)


lemma Exit_not_weak_control_dependent:
  "n weakly controls (_Exit_)  False"
by(auto simp:weak_control_dependences_eq 
        intro:Exit_not_dyn_weak_control_dependent)

end

end

Theory PDG

section ‹Program Dependence Graph›

theory PDG imports 
  DataDependence 
  StandardControlDependence
  WeakControlDependence
  "../Basic/CFGExit_wf" 
begin

locale PDG = 
  CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')") +
  fixes control_dependence :: "'node  'node  bool" 
("_ controls _ " [51,0])
  assumes Exit_not_control_dependent:"n controls n'  n'  (_Exit_)"
  assumes control_dependence_path:
  "n controls n' 
   as. CFG.path sourcenode targetnode valid_edge n as n'  as  []"

begin


inductive cdep_edge :: "'node  'node  bool" 
    ("_ cd _" [51,0] 80)
  and ddep_edge :: "'node  'var  'node  bool"
    ("_ -_dd _" [51,0,0] 80)
  and PDG_edge :: "'node  'var option  'node  bool"

where
    (* Syntax *)
  "n cd n' == PDG_edge n None n'"
  | "n -Vdd n' == PDG_edge n (Some V) n'"

    (* Rules *)
  | PDG_cdep_edge:
  "n controls n'  n cd n'"

  | PDG_ddep_edge:
  "n influences V in n'  n -Vdd n'"


inductive PDG_path :: "'node  'node  bool"
("_ d* _" [51,0] 80) 

where PDG_path_Nil:
  "valid_node n  n d* n"

  | PDG_path_Append_cdep:
  "n d* n''; n'' cd n'  n d* n'"

  | PDG_path_Append_ddep:
  "n d* n''; n'' -Vdd n'  n d* n'"


lemma PDG_path_cdep:"n cd n'  n d* n'"
apply -
apply(rule PDG_path_Append_cdep, rule PDG_path_Nil)
by(auto elim!:PDG_edge.cases dest:control_dependence_path path_valid_node)

lemma PDG_path_ddep:"n -Vdd n'  n d* n'"
apply -
apply(rule PDG_path_Append_ddep, rule PDG_path_Nil)
by(auto elim!:PDG_edge.cases dest:path_valid_node simp:data_dependence_def)

lemma PDG_path_Append:
  "n'' d* n'; n d* n''  n d* n'"
by(induct rule:PDG_path.induct,auto intro:PDG_path.intros)


lemma PDG_cdep_edge_CFG_path:
  assumes "n cd n'" obtains as where "n -as→* n'" and "as  []"
  using n cd n'
  by(auto elim:PDG_edge.cases dest:control_dependence_path)

lemma PDG_ddep_edge_CFG_path:
  assumes "n -Vdd n'" obtains as where "n -as→* n'" and "as  []"
  using n -Vdd n'
  by(auto elim!:PDG_edge.cases simp:data_dependence_def)

lemma PDG_path_CFG_path:
  assumes "n d* n'" obtains as where "n -as→* n'"
proof(atomize_elim)
  from n d* n' show "as. n -as→* n'"
  proof(induct rule:PDG_path.induct)
    case (PDG_path_Nil n)
    hence "n -[]→* n" by(rule empty_path)
    thus ?case by blast
  next
    case (PDG_path_Append_cdep n n'' n')
    from n'' cd n' obtain as where "n'' -as→* n'"
      by(fastforce elim:PDG_cdep_edge_CFG_path)
    with as. n -as→* n'' obtain as' where "n -as'@as→* n'"
      by(auto dest:path_Append)
    thus ?case by blast
  next
    case (PDG_path_Append_ddep n n'' V n')
    from n'' -Vdd n' obtain as where "n'' -as→* n'"
      by(fastforce elim:PDG_ddep_edge_CFG_path)
    with as. n -as→* n'' obtain as' where "n -as'@as→* n'"
      by(auto dest:path_Append)
    thus ?case by blast
  qed
qed


lemma PDG_path_Exit:"n d* n'; n' = (_Exit_)  n = (_Exit_)"
apply(induct rule:PDG_path.induct)
by(auto elim:PDG_edge.cases dest:Exit_not_control_dependent 
        simp:data_dependence_def)


lemma PDG_path_not_inner:
  "n d* n'; ¬ inner_node n'  n = n'"
proof(induct rule:PDG_path.induct)
  case (PDG_path_Nil n)
  thus ?case by simp
next
  case (PDG_path_Append_cdep n n'' n')
  from n'' cd n' ¬ inner_node n' have False
    apply -
    apply(erule PDG_edge.cases) apply(auto simp:inner_node_def)
      apply(fastforce dest:control_dependence_path path_valid_node)
     apply(fastforce dest:control_dependence_path path_valid_node)
    by(fastforce dest:Exit_not_control_dependent)
  thus ?case by simp
next
  case (PDG_path_Append_ddep n n'' V n')
  from n'' -Vdd n' ¬ inner_node n' have False
    apply -
    apply(erule PDG_edge.cases) 
    by(auto dest:path_valid_node simp:inner_node_def data_dependence_def)
  thus ?case by simp
qed


subsection ‹Definition of the static backward slice›

text ‹Node: instead of a single node, we calculate the backward slice of a set
  of nodes.›

definition PDG_BS :: "'node set  'node set"
  where "PDG_BS S  {n'. n. n' d* n  n  S  valid_node n}"


lemma PDG_BS_valid_node:"n  PDG_BS S  valid_node n"
  by(auto elim:PDG_path_CFG_path dest:path_valid_node simp:PDG_BS_def 
          split:if_split_asm)

lemma Exit_PDG_BS:"n  PDG_BS {(_Exit_)}  n = (_Exit_)"
  by(fastforce dest:PDG_path_Exit simp:PDG_BS_def)


end


subsection ‹Instantiate static PDG›

subsubsection ‹Standard control dependence›

locale StandardControlDependencePDG = 
  Postdomination sourcenode targetnode kind valid_edge Entry Exit +
  CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')")

begin

lemma PDG_scd:
  "PDG sourcenode targetnode kind valid_edge (_Entry_) 
       Def Use state_val (_Exit_) standard_control_dependence"
proof(unfold_locales)
  fix n n' assume "n controlss n'"
  show "n'  (_Exit_)"
  proof
    assume "n' = (_Exit_)"
    with n controlss n' show False
      by(fastforce intro:Exit_not_standard_control_dependent)
  qed
next
  fix n n' assume "n controlss n'"
  thus "as. n -as→* n'  as  []"
    by(fastforce simp:standard_control_dependence_def)
qed


(*<*)
lemmas PDG_cdep_edge = PDG.PDG_cdep_edge[OF PDG_scd]
lemmas PDG_path_Nil = PDG.PDG_path_Nil[OF PDG_scd]
lemmas PDG_path_Append = PDG.PDG_path_Append[OF PDG_scd]
lemmas PDG_path_CFG_path = PDG.PDG_path_CFG_path[OF PDG_scd]
lemmas PDG_path_cdep = PDG.PDG_path_cdep[OF PDG_scd]
lemmas PDG_path_ddep = PDG.PDG_path_ddep[OF PDG_scd]
lemmas PDG_path_not_inner = PDG.PDG_path_not_inner[OF PDG_scd]
lemmas PDG_path_Exit = PDG.PDG_path_Exit[OF PDG_scd]


definition PDG_BS_s :: "'node set  'node set" ("PDG'_BS")
  where "PDG_BS S  
  PDG.PDG_BS sourcenode targetnode valid_edge Def Use standard_control_dependence S"

lemma [simp]: "PDG.PDG_BS sourcenode targetnode valid_edge Def Use 
  standard_control_dependence S = PDG_BS S"
  by(simp add:PDG_BS_s_def)

lemmas PDG_BS_def = PDG.PDG_BS_def[OF PDG_scd,simplified]
lemmas PDG_BS_valid_node = PDG.PDG_BS_valid_node[OF PDG_scd,simplified]
lemmas Exit_PDG_BS = PDG.Exit_PDG_BS[OF PDG_scd,simplified]
(*>*)

end

subsubsection ‹Weak control dependence›

locale WeakControlDependencePDG = 
  StrongPostdomination sourcenode targetnode kind valid_edge Entry Exit +
  CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  'state edge_kind" and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node  'var set"
  and Use :: "'node  'var set" and state_val :: "'state  'var  'val"
  and Exit :: "'node" ("'('_Exit'_')")

begin

lemma PDG_wcd:
  "PDG sourcenode targetnode kind valid_edge (_Entry_) 
       Def Use state_val (_Exit_) weak_control_dependence"
proof(unfold_locales)
  fix n n' assume "n weakly controls n'"
  show "n'  (_Exit_)"
  proof
    assume "n' = (_Exit_)"
    with n weakly controls n' show False
      by(fastforce intro:Exit_not_weak_control_dependent)
  qed
next
  fix n n' assume "n weakly controls n'"
  thus "as. n -as→* n'  as  []"
    by(fastforce simp:weak_control_dependence_def)
qed

(*<*)
lemmas PDG_cdep_edge = PDG.PDG_cdep_edge[OF PDG_wcd]
lemmas PDG_path_Nil = PDG.PDG_path_Nil[OF PDG_wcd]
lemmas PDG_path_Append = PDG.PDG_path_Append[OF PDG_wcd]
lemmas PDG_path_CFG_path = PDG.PDG_path_CFG_path[OF PDG_wcd]
lemmas PDG_path_cdep = PDG.PDG_path_cdep[OF PDG_wcd]
lemmas PDG_path_ddep = PDG.PDG_path_ddep[OF PDG_wcd]
lemmas PDG_path_not_inner = PDG.PDG_path_not_inner[OF PDG_wcd]
lemmas PDG_path_Exit = PDG.PDG_path_Exit[OF PDG_wcd]


definition PDG_BS_w :: "'node set  'node set" ("PDG'_BS")
  where "PDG_BS S  
  PDG.PDG_BS sourcenode targetnode valid_edge Def Use weak_control_dependence S"

lemma [simp]: "PDG.PDG_BS sourcenode targetnode valid_edge Def Use 
  weak_control_dependence S = PDG_BS S"
  by(simp add:PDG_BS_w_def)

lemmas PDG_BS_def = PDG.PDG_BS_def[OF PDG_wcd,simplified]
lemmas PDG_BS_valid_node = PDG.PDG_BS_valid_node[OF PDG_wcd,simplified]
lemmas Exit_PDG_BS = PDG.Exit_PDG_BS[OF PDG_wcd,simplified]
(*>*)

end

end

Theory WeakOrderDependence

section ‹Weak Order Dependence›

theory WeakOrderDependence imports "../Basic/CFG" DataDependence begin

text ‹Weak order dependence is just defined as a static control dependence›

subsection‹Definition and some lemmas›

definition (in CFG) weak_order_dependence :: "'node  'node  'node  bool"
   ("_ wod _,_")
where wod_def:"n wod n1,n2  ((n1  n2) 
   (as. (n -as→* n1)  (n2  set (sourcenodes as))) 
   (as. (n -as→* n2)  (n1  set (sourcenodes as))) 
   (a. (valid_edge a)  (n = sourcenode a)  
        ((as. (targetnode a -as→* n1)   
               (as'. (targetnode a -as'→* n2)  n1  set(sourcenodes as'))) 
         (as. (targetnode a -as→* n2)   
               (as'. (targetnode a -as'→* n1)  n2  set(sourcenodes as'))))))"




inductive_set (in CFG_wf) wod_backward_slice :: "'node set  'node set" 
for S :: "'node set"
  where refl:"valid_node n; n  S  n  wod_backward_slice S"
  
  | cd_closed:
  "n' wod n1,n2; n1  wod_backward_slice S; n2  wod_backward_slice S
   n'  wod_backward_slice S"

  | dd_closed:"n' influences V in n''; n''  wod_backward_slice S
   n'  wod_backward_slice S"


lemma (in CFG_wf) 
  wod_backward_slice_valid_node:"n  wod_backward_slice S  valid_node n"
by(induct rule:wod_backward_slice.induct,
   auto dest:path_valid_node simp:wod_def data_dependence_def)


end

Theory CDepInstantiations

section ‹Instantiate framework with control dependences›

theory CDepInstantiations imports 
  Slice 
  PDG 
  WeakOrderDependence 
begin

subsection‹Standard control dependence›

context StandardControlDependencePDG begin

lemma Exit_in_obs_slice_node:"(_Exit_)  obs n' (PDG_BS S)  (_Exit_)  S"
  by(auto elim:obsE PDG_path_CFG_path simp:PDG_BS_def split:if_split_asm)


abbreviation PDG_path' :: "'node  'node  bool" ("_ d* _" [51,0] 80)
  where "n d* n'  PDG.PDG_path sourcenode targetnode valid_edge Def Use
  standard_control_dependence n n'"

lemma cd_closed:
  "n'  PDG_BS S; n controlss n'  n  PDG_BS S"
  by(simp add:PDG_BS_def)(blast dest:PDG_cdep_edge PDG_path_Append PDG_path_cdep)


lemma obs_postdominate:
  assumes "n  obs n' (PDG_BS S)" and "n  (_Exit_)" shows "n postdominates n'"
proof(rule ccontr)
  assume "¬ n postdominates n'"
  from n  obs n' (PDG_BS S) have "valid_node n" by(fastforce dest:in_obs_valid)
  with n  obs n' (PDG_BS S) n  (_Exit_) have "n postdominates n"
    by(fastforce intro:postdominate_refl)
  from n  obs n' (PDG_BS S) obtain as where "n' -as→* n"
    and "n'  set(sourcenodes as). n'  (PDG_BS S)"
    and "n  (PDG_BS S)" by(erule obsE)
  from n postdominates n ¬ n postdominates n' n' -as→* n
  obtain as' a as'' where [simp]:"as = as'@a#as''" and "valid_edge a"
    and "¬ n postdominates (sourcenode a)" and "n postdominates (targetnode a)"
    by -(erule postdominate_path_branch)
  from ¬ n postdominates (sourcenode a) valid_edge a ‹valid_node n
  obtain asx  where "sourcenode a -asx→* (_Exit_)"
    and "n  set(sourcenodes asx)" by(auto simp:postdominate_def)
  from sourcenode a -asx→* (_Exit_) valid_edge a
  obtain ax asx' where [simp]:"asx = ax#asx'"
    apply - apply(erule path.cases)
    apply(drule_tac s="(_Exit_)" in sym)
    apply simp
    apply(drule Exit_source)
    by simp_all
  with sourcenode a -asx→* (_Exit_) have "sourcenode a -[]@ax#asx'→* (_Exit_)" 
    by simp
  hence "valid_edge ax" and [simp]:"sourcenode a = sourcenode ax"
    and "targetnode ax -asx'→* (_Exit_)"
    by(fastforce dest:path_split)+
  with n  set(sourcenodes asx) have "¬ n postdominates targetnode ax"
    by(fastforce simp:postdominate_def sourcenodes_def)
  from n  obs n' (PDG_BS S) n'  set(sourcenodes as). n'  (PDG_BS S)
  have "n  set (sourcenodes (a#as''))"
    by(fastforce elim:obs.cases simp:sourcenodes_def)
  from n' -as→* n have "sourcenode a -a#as''→* n"
    by(fastforce dest:path_split_second)
  with n postdominates (targetnode a) ¬ n postdominates targetnode ax
    valid_edge ax n  set (sourcenodes (a#as''))
  have "sourcenode a controlss n" by(fastforce simp:standard_control_dependence_def)
  with n  obs n' (PDG_BS S) have "sourcenode a  (PDG_BS S)"
    by(fastforce intro:cd_closed PDG_cdep_edge elim:obs.cases)
  with n'  set(sourcenodes as). n'  (PDG_BS S) 
  show False by(simp add:sourcenodes_def)
qed


lemma obs_singleton:"(m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {}"
proof(rule ccontr)
  assume "¬ ((m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {})"
  hence "nx nx'. nx  obs n (PDG_BS S)  nx'  obs n (PDG_BS S) 
    nx  nx'" by auto
  then obtain nx nx' where "nx  obs n (PDG_BS S)" and "nx'  obs n (PDG_BS S)"
    and "nx  nx'" by auto
  from nx  obs n (PDG_BS S) obtain as where "n -as→* nx" 
    and "n'  set(sourcenodes as). n'  (PDG_BS S)" and "nx  (PDG_BS S)" 
    by(erule obsE)
  from n -as→* nx have "valid_node nx" by(fastforce dest:path_valid_node)
  with nx  (PDG_BS S) have "obs nx (PDG_BS S) = {nx}" by -(rule n_in_obs)
  with n -as→* nx nx  obs n (PDG_BS S) nx'  obs n (PDG_BS S) nx  nx'
  have "as  []" by(fastforce elim:path.cases)
  with n -as→* nx nx  obs n (PDG_BS S) nx'  obs n (PDG_BS S) 
    nx  nx' ‹obs nx (PDG_BS S) = {nx} n'  set(sourcenodes as). n'  (PDG_BS S)
  have "a as' as''. n -as'→* sourcenode a  targetnode a -as''→* nx 
                     valid_edge a  as = as'@a#as''  
                     obs (targetnode a) (PDG_BS S) = {nx}  
                    (¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
                       obs (sourcenode a) (PDG_BS S) = {}))"
  proof(induct arbitrary:nx' rule:path.induct)
    case (Cons_path n'' as n' a n)
    note [simp] = sourcenode a = n[THEN sym] targetnode a = n''[THEN sym]
    note more_than_one = n'  obs n (PDG_BS S) nx'  obs n (PDG_BS S) n'  nx'
    note IH = nx'. n'  obs n'' (PDG_BS S); nx'  obs n'' (PDG_BS S); n'  nx'; 
      obs n' (PDG_BS S) = {n'}; n'set (sourcenodes as). n'  (PDG_BS S); as  []
       a as' as''. n'' -as'→* sourcenode a  targetnode a -as''→* n' 
      valid_edge a  as = as'@a#as''  obs (targetnode a) (PDG_BS S) = {n'} 
      (¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
      obs (sourcenode a) (PDG_BS S) = {}))
    from n'set (sourcenodes (a#as)). n'  (PDG_BS S)
    have "n'set (sourcenodes as). n'  (PDG_BS S)" and "sourcenode a  (PDG_BS S)"
      by(simp_all add:sourcenodes_def)
    show ?case
    proof(cases "as = []")
      case True
      with n'' -as→* n' have [simp]:"n' = n''" by(fastforce elim:path.cases)
      from more_than_one
      have "¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
               obs (sourcenode a) (PDG_BS S) = {})"
        by auto
      with ‹obs n' (PDG_BS S) = {n'} True valid_edge a show ?thesis
        apply(rule_tac x="a" in exI)
        apply(rule_tac x="[]" in exI)
        apply(rule_tac x="[]" in exI)
        by(auto intro!:empty_path)
    next
      case False
      hence "as  []" .
      from n'' -as→* n' n'set (sourcenodes as). n'  (PDG_BS S) 
      have "obs n' (PDG_BS S)  obs n'' (PDG_BS S)" by(rule path_obs_subset)
      show ?thesis
      proof(cases "obs n' (PDG_BS S) = obs n'' (PDG_BS S)")
        case True
        with n'' -as→* n' valid_edge a ‹obs n' (PDG_BS S) = {n'} more_than_one
        show ?thesis
          apply(rule_tac x="a" in exI)
          apply(rule_tac x="[]" in exI)
          apply(rule_tac x="as" in exI)
          by(fastforce intro:empty_path)
      next
        case False
        with ‹obs n' (PDG_BS S)  obs n'' (PDG_BS S)
        have "obs n' (PDG_BS S)  obs n'' (PDG_BS S)" by simp
        with ‹obs n' (PDG_BS S) = {n'} obtain ni where "n'  obs n'' (PDG_BS S)"
          and "ni  obs n'' (PDG_BS S)" and "n'  ni" by auto
        from IH[OF this ‹obs n' (PDG_BS S) = {n'} 
          n'set (sourcenodes as). n'  (PDG_BS S) as  []] obtain a' as' as''
          where "n'' -as'→* sourcenode a'" and "targetnode a' -as''→* n'"
          and "valid_edge a'" and [simp]:"as = as'@a'#as''" 
          and "obs (targetnode a') (PDG_BS S) = {n'}"
          and more_than_one':"¬ (m. obs (sourcenode a') (PDG_BS S) = {m}  
          obs (sourcenode a') (PDG_BS S) = {})"
          by blast
        from n'' -as'→* sourcenode a' valid_edge a
        have "n -a#as'→* sourcenode a'" by(fastforce intro:path.Cons_path)
        with targetnode a' -as''→* n' ‹obs (targetnode a') (PDG_BS S) = {n'}
          more_than_one' valid_edge a' show ?thesis
          apply(rule_tac x="a'" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="as''" in exI)
          by fastforce
      qed
    qed
  qed simp
  then obtain a as' as'' where "valid_edge a"
    and "obs (targetnode a) (PDG_BS S) = {nx}"
    and more_than_one:"¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
                         obs (sourcenode a) (PDG_BS S) = {})"
    by blast
  have "sourcenode a  (PDG_BS S)"
  proof(rule ccontr)
    assume "¬ sourcenode a  PDG_BS S"
    hence "sourcenode a  PDG_BS S" by simp
    with valid_edge a have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
      by(fastforce intro!:n_in_obs)
    with more_than_one show False by simp
  qed
  with valid_edge a 
  have "obs (targetnode a) (PDG_BS S)  obs (sourcenode a) (PDG_BS S)"
    by(rule edge_obs_subset)
  with ‹obs (targetnode a) (PDG_BS S) = {nx} 
  have "nx  obs (sourcenode a) (PDG_BS S)" by simp
  with more_than_one obtain m  where "m  obs (sourcenode a) (PDG_BS S)"
    and "nx  m" by auto
  from m  obs (sourcenode a) (PDG_BS S) 
  have "valid_node m" by(fastforce dest:in_obs_valid)
  from ‹obs (targetnode a) (PDG_BS S) = {nx} have "valid_node nx" 
    by(fastforce dest:in_obs_valid)
  show False
  proof(cases "m postdominates (sourcenode a)")
    case True
    with nx  obs (sourcenode a) (PDG_BS S) m  obs (sourcenode a) (PDG_BS S)
    have "m postdominates nx"
      by(fastforce intro:postdominate_path_targetnode elim:obs.cases)
    with nx  m have "¬ nx postdominates m" by(fastforce dest:postdominate_antisym)
    have "(_Exit_) -[]→* (_Exit_)" by(fastforce intro:empty_path)
    with m postdominates nx have "nx  (_Exit_)"
      by(fastforce simp:postdominate_def sourcenodes_def)
    have "¬ nx postdominates (sourcenode a)"
    proof(rule ccontr)
      assume "¬ ¬ nx postdominates sourcenode a"
      hence "nx postdominates sourcenode a" by simp
      from m  obs (sourcenode a) (PDG_BS S) nx  obs (sourcenode a) (PDG_BS S)
      obtain asx' where "sourcenode a -asx'→* m" and "nx  set(sourcenodes asx')"
        by(fastforce elim:obs.cases)
      with nx postdominates sourcenode a have "nx postdominates m"
        by(rule postdominate_path_targetnode)
      with ¬ nx postdominates m show False by simp
    qed
    with nx  obs (sourcenode a) (PDG_BS S) ‹valid_node nx nx  (_Exit_) 
    show False by(fastforce dest:obs_postdominate)
  next
    case False
    show False
    proof(cases "m = Exit")
      case True
      from m  obs (sourcenode a) (PDG_BS S) nx  obs (sourcenode a) (PDG_BS S)
      obtain xs where "sourcenode a -xs→* m" and "nx  set(sourcenodes xs)"
        by(fastforce elim:obsE)
      obtain x' xs' where [simp]:"xs = x'#xs'"
      proof(cases xs)
        case Nil
        with sourcenode a -xs→* m have [simp]:"sourcenode a = m" by fastforce
        with m  obs (sourcenode a) (PDG_BS S) 
        have "m  (PDG_BS S)" by(metis obsE)
        with ‹valid_node m have "obs m (PDG_BS S) = {m}"
          by(rule n_in_obs)
        with nx  obs (sourcenode a) (PDG_BS S) nx  m have False
          by fastforce
        thus ?thesis by simp
      qed blast
      from sourcenode a -xs→* m have "sourcenode a = sourcenode x'" 
        and "valid_edge x'" and "targetnode x' -xs'→* m"
        by(auto elim:path_split_Cons)
      from targetnode x' -xs'→* m nx  set(sourcenodes xs) valid_edge x' 
        ‹valid_node m True
      have "¬ nx postdominates (targetnode x')" 
        by(fastforce simp:postdominate_def sourcenodes_def)
      from nx  m True have "nx  (_Exit_)" by simp
      with ‹obs (targetnode a) (PDG_BS S) = {nx}
      have "nx postdominates (targetnode a)"
        by(fastforce intro:obs_postdominate)
      from ‹obs (targetnode a) (PDG_BS S) = {nx}
      obtain ys where "targetnode a -ys→* nx" 
        and "nx'  set(sourcenodes ys). nx'  (PDG_BS S)"
        and "nx  (PDG_BS S)" by(fastforce elim:obsE)
      hence "nx  set(sourcenodes ys)"by fastforce
      have "sourcenode a  nx"
      proof
        assume "sourcenode a = nx"
        from nx  obs (sourcenode a) (PDG_BS S)
        have "nx  (PDG_BS S)" by -(erule obsE)
        with ‹valid_node nx have "obs nx (PDG_BS S) = {nx}" by -(erule n_in_obs)
        with sourcenode a = nx m  obs (sourcenode a) (PDG_BS S) 
          nx  m show False by fastforce
      qed
      with nx  set(sourcenodes ys) have "nx  set(sourcenodes (a#ys))"
        by(fastforce simp:sourcenodes_def)
      from valid_edge a targetnode a -ys→* nx
      have "sourcenode a -a#ys→* nx" by(fastforce intro:Cons_path)
      from sourcenode a -a#ys→* nx nx  set(sourcenodes (a#ys))
        nx postdominates (targetnode a) valid_edge x'
        ¬ nx postdominates (targetnode x') sourcenode a = sourcenode x'
      have "(sourcenode a) controlss nx"
        by(fastforce simp:standard_control_dependence_def)
      with nx  (PDG_BS S) have "sourcenode a  (PDG_BS S)"
        by(rule cd_closed)
      with valid_edge a have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
        by(fastforce intro!:n_in_obs)
      with m  obs (sourcenode a) (PDG_BS S)
        nx  obs (sourcenode a) (PDG_BS S) nx  m
      show False by simp
    next
      case False
      with m  obs (sourcenode a) (PDG_BS S) ‹valid_node m
        ¬ m postdominates sourcenode a 
      show False by(fastforce dest:obs_postdominate)
    qed
  qed
qed


lemma PDGBackwardSliceCorrect:
  "BackwardSlice sourcenode targetnode kind valid_edge
        (_Entry_) Def Use state_val PDG_BS"
proof(unfold_locales)
  fix n S assume "n  PDG_BS S"
  thus "valid_node n" by(rule PDG_BS_valid_node)
next
  fix n S assume "valid_node n" and "n  S"
  thus "n  PDG_BS S" by(fastforce intro:PDG_path_Nil simp:PDG_BS_def)
next
  fix n' S n V
  assume "n'  PDG_BS S" and "n influences V in n'"
  thus "n  PDG_BS S"
    by(auto dest:PDG.PDG_path_ddep[OF PDG_scd,OF PDG.PDG_ddep_edge[OF PDG_scd]]
            dest:PDG_path_Append simp:PDG_BS_def split:if_split_asm)
next
  fix n S
  have "(m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {}" 
    by(rule obs_singleton)
  thus "finite (obs n (PDG_BS S))" by fastforce
next
  fix n S
  have "(m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {}" 
    by(rule obs_singleton)
  thus "card (obs n (PDG_BS S))  1" by fastforce
qed

end


subsection‹Weak control dependence›

context WeakControlDependencePDG begin

lemma Exit_in_obs_slice_node:"(_Exit_)  obs n' (PDG_BS S)  (_Exit_)  S"
  by(auto elim:obsE PDG_path_CFG_path simp:PDG_BS_def split:if_split_asm)


lemma cd_closed:
  "n'  PDG_BS S; n weakly controls n'  n  PDG_BS S"
  by(simp add:PDG_BS_def)(blast dest:PDG_cdep_edge PDG_path_Append PDG_path_cdep)


lemma obs_strong_postdominate:
  assumes "n  obs n' (PDG_BS S)" and "n  (_Exit_)" 
  shows "n strongly-postdominates n'"
proof(rule ccontr)
  assume "¬ n strongly-postdominates n'"
  from n  obs n' (PDG_BS S) have "valid_node n" by(fastforce dest:in_obs_valid)
  with n  obs n' (PDG_BS S) n  (_Exit_) have "n strongly-postdominates n"
    by(fastforce intro:strong_postdominate_refl)
  from n  obs n' (PDG_BS S) obtain as where "n' -as→* n"
    and "n'  set(sourcenodes as). n'  (PDG_BS S)"
    and "n  (PDG_BS S)" by(erule obsE)
  from n strongly-postdominates n ¬ n strongly-postdominates n' n' -as→* n
  obtain as' a as'' where [simp]:"as = as'@a#as''" and "valid_edge a"
    and "¬ n strongly-postdominates (sourcenode a)" and 
    "n strongly-postdominates (targetnode a)"
    by -(erule strong_postdominate_path_branch)
  from n  obs n' (PDG_BS S) n'  set(sourcenodes as). n'  (PDG_BS S) 
  have "n  set (sourcenodes (a#as''))"
    by(fastforce elim:obs.cases simp:sourcenodes_def)
  from n' -as→* n have "sourcenode a -a#as''→* n"
    by(fastforce dest:path_split_second)
  from ¬ n strongly-postdominates (sourcenode a) valid_edge a ‹valid_node n
  obtain a' where "sourcenode a' = sourcenode a"
    and "valid_edge a'" and "¬ n strongly-postdominates (targetnode a')"
    by(fastforce elim:not_strong_postdominate_predecessor_successor)
  with n strongly-postdominates (targetnode a) n  set (sourcenodes (a#as''))
    sourcenode a -a#as''→* n
  have "sourcenode a weakly controls n"
    by(fastforce simp:weak_control_dependence_def)
  with n  obs n' (PDG_BS S) have "sourcenode a  (PDG_BS S)"
    by(fastforce intro:cd_closed PDG_cdep_edge elim:obs.cases)
  with n'  set(sourcenodes as). n'  (PDG_BS S)
  show False by(simp add:sourcenodes_def)
qed


lemma obs_singleton:"(m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {}"
proof(rule ccontr)
  assume "¬ ((m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {})"
  hence "nx nx'. nx  obs n (PDG_BS S)  nx'  obs n (PDG_BS S) 
    nx  nx'" by auto
  then obtain nx nx' where "nx  obs n (PDG_BS S)" and "nx'  obs n (PDG_BS S)"
    and "nx  nx'" by auto
  from nx  obs n (PDG_BS S) obtain as where "n -as→* nx" 
    and "n'  set(sourcenodes as). n'  (PDG_BS S)" and "nx  (PDG_BS S)" 
    by(erule obsE)
  from n -as→* nx have "valid_node nx" by(fastforce dest:path_valid_node)
  with nx  (PDG_BS S) have "obs nx (PDG_BS S) = {nx}" by -(rule n_in_obs)
  with n -as→* nx nx  obs n (PDG_BS S) nx'  obs n (PDG_BS S) nx  nx'
  have "as  []" by(fastforce elim:path.cases)
  with n -as→* nx nx  obs n (PDG_BS S) nx'  obs n (PDG_BS S) 
    nx  nx' ‹obs nx (PDG_BS S) = {nx} n'  set(sourcenodes as). n'  (PDG_BS S)
  have "a as' as''. n -as'→* sourcenode a  targetnode a -as''→* nx 
                     valid_edge a  as = as'@a#as''  
                     obs (targetnode a) (PDG_BS S) = {nx}  
                    (¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
                       obs (sourcenode a) (PDG_BS S) = {}))"
  proof(induct arbitrary:nx' rule:path.induct)
    case (Cons_path n'' as n' a n)
    note [simp] = sourcenode a = n[THEN sym] targetnode a = n''[THEN sym]
    note more_than_one = n'  obs n (PDG_BS S) nx'  obs n (PDG_BS S) n'  nx'
    note IH = nx'. n'  obs n'' (PDG_BS S); nx'  obs n'' (PDG_BS S); n'  nx'; 
      obs n' (PDG_BS S) = {n'}; n'set (sourcenodes as). n'  (PDG_BS S); as  []
       a as' as''. n'' -as'→* sourcenode a  targetnode a -as''→* n' 
      valid_edge a  as = as'@a#as''  obs (targetnode a) (PDG_BS S) = {n'} 
      (¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
      obs (sourcenode a) (PDG_BS S) = {}))
    from n'set (sourcenodes (a#as)). n'  (PDG_BS S)
    have "n'set (sourcenodes as). n'  (PDG_BS S)" and "sourcenode a  (PDG_BS S)"
      by(simp_all add:sourcenodes_def)
    show ?case
    proof(cases "as = []")
      case True
      with n'' -as→* n' have [simp]:"n' = n''" by(fastforce elim:path.cases)
      from more_than_one
      have "¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
               obs (sourcenode a) (PDG_BS S) = {})"
        by auto
      with ‹obs n' (PDG_BS S) = {n'} True valid_edge a show ?thesis
        apply(rule_tac x="a" in exI)
        apply(rule_tac x="[]" in exI)
        apply(rule_tac x="[]" in exI)
        by(auto intro!:empty_path)
    next
      case False
      hence "as  []" .
      from n'' -as→* n' n'set (sourcenodes as). n'  (PDG_BS S) 
      have "obs n' (PDG_BS S)  obs n'' (PDG_BS S)" by(rule path_obs_subset)
      show ?thesis
      proof(cases "obs n' (PDG_BS S) = obs n'' (PDG_BS S)")
        case True
        with n'' -as→* n' valid_edge a ‹obs n' (PDG_BS S) = {n'} more_than_one
        show ?thesis
          apply(rule_tac x="a" in exI)
          apply(rule_tac x="[]" in exI)
          apply(rule_tac x="as" in exI)
          by(fastforce intro:empty_path)
      next
        case False
        with ‹obs n' (PDG_BS S)  obs n'' (PDG_BS S)
        have "obs n' (PDG_BS S)  obs n'' (PDG_BS S)" by simp
        with ‹obs n' (PDG_BS S) = {n'} obtain ni where "n'  obs n'' (PDG_BS S)"
          and "ni  obs n'' (PDG_BS S)" and "n'  ni" by auto
        from IH[OF this ‹obs n' (PDG_BS S) = {n'} 
          n'set (sourcenodes as). n'  (PDG_BS S) as  []] obtain a' as' as''
          where "n'' -as'→* sourcenode a'" and "targetnode a' -as''→* n'"
          and "valid_edge a'" and [simp]:"as = as'@a'#as''" 
          and "obs (targetnode a') (PDG_BS S) = {n'}"
          and more_than_one':"¬ (m. obs (sourcenode a') (PDG_BS S) = {m}  
          obs (sourcenode a') (PDG_BS S) = {})"
          by blast
        from n'' -as'→* sourcenode a' valid_edge a
        have "n -a#as'→* sourcenode a'" by(fastforce intro:path.Cons_path)
        with targetnode a' -as''→* n' ‹obs (targetnode a') (PDG_BS S) = {n'}
          more_than_one' valid_edge a' show ?thesis
          apply(rule_tac x="a'" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="as''" in exI)
          by fastforce
      qed
    qed
  qed simp
  then obtain a as' as'' where "valid_edge a"
    and "obs (targetnode a) (PDG_BS S) = {nx}"
    and more_than_one:"¬ (m. obs (sourcenode a) (PDG_BS S) = {m}  
                         obs (sourcenode a) (PDG_BS S) = {})"
    by blast
  have "sourcenode a  (PDG_BS S)"
  proof(rule ccontr)
    assume "¬ sourcenode a  PDG_BS S"
    hence "sourcenode a  PDG_BS S" by simp
    with valid_edge a have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
      by(fastforce intro!:n_in_obs)
    with more_than_one show False by simp
  qed
  with valid_edge a 
  have "obs (targetnode a) (PDG_BS S)  obs (sourcenode a) (PDG_BS S)"
    by(rule edge_obs_subset)
  with ‹obs (targetnode a) (PDG_BS S) = {nx} 
  have "nx  obs (sourcenode a) (PDG_BS S)" by simp
  with more_than_one obtain m  where "m  obs (sourcenode a) (PDG_BS S)"
    and "nx  m" by auto
  from m  obs (sourcenode a) (PDG_BS S) 
  have "valid_node m" by(fastforce dest:in_obs_valid)
  from ‹obs (targetnode a) (PDG_BS S) = {nx} have "valid_node nx" 
    by(fastforce dest:in_obs_valid)
  show False
  proof(cases "m strongly-postdominates (sourcenode a)")
    case True
    with nx  obs (sourcenode a) (PDG_BS S) m  obs (sourcenode a) (PDG_BS S)
    have "m strongly-postdominates nx"
      by(fastforce intro:strong_postdominate_path_targetnode elim:obs.cases)
    with nx  m have "¬ nx strongly-postdominates m" 
      by(fastforce dest:strong_postdominate_antisym)
    have "(_Exit_) -[]→* (_Exit_)" by(fastforce intro:empty_path)
    with m strongly-postdominates nx have "nx  (_Exit_)"
      by(fastforce simp:strong_postdominate_def sourcenodes_def postdominate_def)
    have "¬ nx strongly-postdominates (sourcenode a)"
    proof(rule ccontr)
      assume "¬ ¬ nx strongly-postdominates sourcenode a"
      hence "nx strongly-postdominates sourcenode a" by simp
      from m  obs (sourcenode a) (PDG_BS S) nx  obs (sourcenode a) (PDG_BS S)
      obtain asx' where "sourcenode a -asx'→* m" and "nx  set(sourcenodes asx')"
        by(fastforce elim:obs.cases)
      with nx strongly-postdominates sourcenode a have "nx strongly-postdominates m"
        by(rule strong_postdominate_path_targetnode)
      with ¬ nx strongly-postdominates m show False by simp
    qed
    with nx  obs (sourcenode a) (PDG_BS S) ‹valid_node nx nx  (_Exit_) 
    show False by(fastforce dest:obs_strong_postdominate)
  next
    case False
    show False
    proof(cases "m = Exit")
      case True
      from m  obs (sourcenode a) (PDG_BS S) nx  obs (sourcenode a) (PDG_BS S)
      obtain xs where "sourcenode a -xs→* m" and "nx  set(sourcenodes xs)"
        by(fastforce elim:obsE)
      obtain x' xs' where [simp]:"xs = x'#xs'"
      proof(cases xs)
        case Nil
        with sourcenode a -xs→* m have [simp]:"sourcenode a = m" by fastforce
        with m  obs (sourcenode a) (PDG_BS S) 
        have "m  (PDG_BS S)" by (metis obsE)
        with ‹valid_node m have "obs m (PDG_BS S) = {m}"
          by(rule n_in_obs)
        with nx  obs (sourcenode a) (PDG_BS S) nx  m have False
          by fastforce
        thus ?thesis by simp
      qed blast
      from sourcenode a -xs→* m have "sourcenode a = sourcenode x'" 
        and "valid_edge x'" and "targetnode x' -xs'→* m"
        by(auto elim:path_split_Cons)
      from targetnode x' -xs'→* m nx  set(sourcenodes xs) valid_edge x' 
        ‹valid_node m True
      have "¬ nx strongly-postdominates (targetnode x')" 
        by(fastforce simp:strong_postdominate_def postdominate_def sourcenodes_def)
      from nx  m True have "nx  (_Exit_)" by simp
      with ‹obs (targetnode a) (PDG_BS S) = {nx}
      have "nx strongly-postdominates (targetnode a)"
        by(fastforce intro:obs_strong_postdominate)
      from ‹obs (targetnode a) (PDG_BS S) = {nx}
      obtain ys where "targetnode a -ys→* nx" 
        and "nx'  set(sourcenodes ys). nx'  (PDG_BS S)"
        and "nx  (PDG_BS S)" by(fastforce elim:obsE)
      hence "nx  set(sourcenodes ys)"by fastforce
      have "sourcenode a  nx"
      proof
        assume "sourcenode a = nx"
        from nx  obs (sourcenode a) (PDG_BS S)
        have "nx  (PDG_BS S)" by -(erule obsE)
        with ‹valid_node nx have "obs nx (PDG_BS S) = {nx}" by -(erule n_in_obs)
        with sourcenode a = nx m  obs (sourcenode a) (PDG_BS S) 
          nx  m show False by fastforce
      qed
      with nx  set(sourcenodes ys) have "nx  set(sourcenodes (a#ys))"
        by(fastforce simp:sourcenodes_def)
      from valid_edge a targetnode a -ys→* nx
      have "sourcenode a -a#ys→* nx" by(fastforce intro:Cons_path)
      from sourcenode a -a#ys→* nx nx  set(sourcenodes (a#ys))
        nx strongly-postdominates (targetnode a) valid_edge x'
        ¬ nx strongly-postdominates (targetnode x') sourcenode a = sourcenode x'
      have "(sourcenode a) weakly controls nx"
        by(fastforce simp:weak_control_dependence_def)
      with nx  (PDG_BS S) have "sourcenode a  (PDG_BS S)"
        by(rule cd_closed)
      with valid_edge a have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
        by(fastforce intro!:n_in_obs)
      with m  obs (sourcenode a) (PDG_BS S)
        nx  obs (sourcenode a) (PDG_BS S) nx  m
      show False by simp
    next
      case False
      with m  obs (sourcenode a) (PDG_BS S) ‹valid_node m
        ¬ m strongly-postdominates sourcenode a 
      show False by(fastforce dest:obs_strong_postdominate)
    qed
  qed
qed


lemma WeakPDGBackwardSliceCorrect:
  "BackwardSlice sourcenode targetnode kind valid_edge
        (_Entry_) Def Use state_val PDG_BS"
proof(unfold_locales)
  fix n S assume "n  PDG_BS S"
  thus "valid_node n" by(rule PDG_BS_valid_node)
next
  fix n S assume "valid_node n" and "n  S"
  thus "n  PDG_BS S" by(fastforce intro:PDG_path_Nil simp:PDG_BS_def)
next
  fix n' S n V assume "n'  PDG_BS S" and "n influences V in n'"
  thus "n  PDG_BS S"
    by(auto dest:PDG.PDG_path_ddep[OF PDG_wcd,OF PDG.PDG_ddep_edge[OF PDG_wcd]]
            dest:PDG_path_Append simp:PDG_BS_def split:if_split_asm)
next
  fix n S
  have "(m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {}" 
    by(rule obs_singleton)
  thus "finite (obs n (PDG_BS S))" by fastforce
next
  fix n S
  have "(m. obs n (PDG_BS S) = {m})  obs n (PDG_BS S) = {}" 
    by(rule obs_singleton)
  thus "card (obs n (PDG_BS S))  1" by fastforce
qed

end


subsection‹Weak order dependence›

context CFG_wf begin

lemma obs_singleton: 
  (*assumes valid:"valid_node n"*)
  shows "(m. obs n (wod_backward_slice S) = {m}) 
         obs n (wod_backward_slice S) = {}"
proof(rule ccontr)
  let ?WOD_BS = "wod_backward_slice S"
  assume "¬ ((m. obs n ?WOD_BS = {m})  obs n ?WOD_BS = {})"
  hence "nx nx'. nx  obs n ?WOD_BS  nx'  obs n ?WOD_BS 
    nx  nx'" by auto
  then obtain nx nx' where "nx  obs n ?WOD_BS" and "nx'  obs n ?WOD_BS"
    and "nx  nx'" by auto
  from nx  obs n ?WOD_BS obtain as where "n -as→* nx" 
    and "n'  set(sourcenodes as). n'  ?WOD_BS" and "nx  ?WOD_BS" 
    by(erule obsE)
  from n -as→* nx have "valid_node nx" by(fastforce dest:path_valid_node)
  with nx  ?WOD_BS have "obs nx ?WOD_BS = {nx}" by -(rule n_in_obs)
  with n -as→* nx nx  obs n ?WOD_BS nx'  obs n ?WOD_BS nx  nx' 
  have "as  []" by(fastforce elim:path.cases)
  with n -as→* nx nx  obs n ?WOD_BS nx'  obs n ?WOD_BS nx  nx' 
    ‹obs nx ?WOD_BS = {nx} n'  set(sourcenodes as). n'  ?WOD_BS
  have "a as' as''. n -as'→* sourcenode a  targetnode a -as''→* nx 
                     valid_edge a  as = as'@a#as''  
                     obs (targetnode a) ?WOD_BS = {nx}  
                    (¬ (m. obs (sourcenode a) ?WOD_BS = {m}  
                       obs (sourcenode a) ?WOD_BS = {}))"
  proof(induct arbitrary:nx' rule:path.induct)
    case (Cons_path n'' as n' a n)
    note [simp] = sourcenode a = n[THEN sym] targetnode a = n''[THEN sym]
    note more_than_one = n'  obs n (?WOD_BS) nx'  obs n (?WOD_BS) n'  nx'
    note IH = nx'. n'  obs n'' (?WOD_BS); nx'  obs n'' (?WOD_BS); n'  nx'; 
      obs n' (?WOD_BS) = {n'}; n'set (sourcenodes as). n'  (?WOD_BS); as  []
       a as' as''. n'' -as'→* sourcenode a  targetnode a -as''→* n' 
      valid_edge a  as = as'@a#as''  obs (targetnode a) (?WOD_BS) = {n'} 
      (¬ (m. obs (sourcenode a) (?WOD_BS) = {m}  
      obs (sourcenode a) (?WOD_BS) = {}))
    from n'set (sourcenodes (a#as)). n'  (?WOD_BS)
    have "n'set (sourcenodes as). n'  (?WOD_BS)" and "sourcenode a  (?WOD_BS)"
      by(simp_all add:sourcenodes_def)
    show ?case
    proof(cases "as = []")
      case True
      with n'' -as→* n' have [simp]:"n' = n''" by(fastforce elim:path.cases)
      from more_than_one
      have "¬ (m. obs (sourcenode a) (?WOD_BS) = {m}  
               obs (sourcenode a) (?WOD_BS) = {})"
        by auto
      with ‹obs n' (?WOD_BS) = {n'} True valid_edge a show ?thesis
        apply(rule_tac x="a" in exI)
        apply(rule_tac x="[]" in exI)
        apply(rule_tac x="[]" in exI)
        by(auto intro!:empty_path)
    next
      case False
      hence "as  []" .
      from n'' -as→* n' n'set (sourcenodes as). n'  (?WOD_BS) 
      have "obs n' (?WOD_BS)  obs n'' (?WOD_BS)" by(rule path_obs_subset)
      show ?thesis
      proof(cases "obs n' (?WOD_BS) = obs n'' (?WOD_BS)")
        case True
        with n'' -as→* n' valid_edge a ‹obs n' (?WOD_BS) = {n'} more_than_one
        show ?thesis
          apply(rule_tac x="a" in exI)
          apply(rule_tac x="[]" in exI)
          apply(rule_tac x="as" in exI)
          by(fastforce intro:empty_path)
      next
        case False
        with ‹obs n' (?WOD_BS)  obs n'' (?WOD_BS)
        have "obs n' (?WOD_BS)  obs n'' (?WOD_BS)" by simp
        with ‹obs n' (?WOD_BS) = {n'} obtain ni where "n'  obs n'' (?WOD_BS)"
          and "ni  obs n'' (?WOD_BS)" and "n'  ni" by auto
        from IH[OF this ‹obs n' (?WOD_BS) = {n'} 
          n'set (sourcenodes as). n'  (?WOD_BS) as  []] obtain a' as' as''
          where "n'' -as'→* sourcenode a'" and "targetnode a' -as''→* n'"
          and "valid_edge a'" and [simp]:"as = as'@a'#as''" 
          and "obs (targetnode a') (?WOD_BS) = {n'}"
          and more_than_one':"¬ (m. obs (sourcenode a') (?WOD_BS) = {m}  
          obs (sourcenode a') (?WOD_BS) = {})"
          by blast
        from n'' -as'→* sourcenode a' valid_edge a
        have "n -a#as'→* sourcenode a'" by(fastforce intro:path.Cons_path)
        with targetnode a' -as''→* n' ‹obs (targetnode a') (?WOD_BS) = {n'}
          more_than_one' valid_edge a' show ?thesis
          apply(rule_tac x="a'" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="as''" in exI)
          by fastforce
      qed
    qed
  qed simp
  then obtain a as' as'' where "valid_edge a"
    and "obs (targetnode a) (?WOD_BS) = {nx}"
    and more_than_one:"¬ (m. obs (sourcenode a) (?WOD_BS) = {m}  
                         obs (sourcenode a) (?WOD_BS) = {})"
    by blast
  have "sourcenode a  (?WOD_BS)"
  proof(rule ccontr)
    assume "¬ sourcenode a  ?WOD_BS"
    hence "sourcenode a  ?WOD_BS" by simp
    with valid_edge a have "obs (sourcenode a) (?WOD_BS) = {sourcenode a}"
      by(fastforce intro!:n_in_obs)
    with more_than_one show False by simp
  qed
  with valid_edge a 
  have "obs (targetnode a) (?WOD_BS)  obs (sourcenode a) (?WOD_BS)"
    by(rule edge_obs_subset)
  with ‹obs (targetnode a) (?WOD_BS) = {nx} 
  have "nx  obs (sourcenode a) (?WOD_BS)" by simp
  with more_than_one obtain m  where "m  obs (sourcenode a) (?WOD_BS)"
    and "nx  m" by auto
  with nx  obs (sourcenode a) (?WOD_BS) obtain as2 
    where "sourcenode a -as2→* m" and "nx  set(sourcenodes as2)" 
    by(fastforce elim:obsE)
  from nx  obs (sourcenode a) (?WOD_BS) m  obs (sourcenode a) (?WOD_BS) 
  obtain as1 where "sourcenode a -as1→* nx" and "m  set(sourcenodes as1)"
    by(fastforce elim:obsE)
  from ‹obs (targetnode a) (?WOD_BS) = {nx} obtain asx 
    where "targetnode a -asx→* nx" by(fastforce elim:obsE)
  have "asx'. targetnode a -asx'→* m  nx  set(sourcenodes asx')"
  proof(rule ccontr)
    assume "¬ (asx'. targetnode a -asx'→* m  nx  set (sourcenodes asx'))"
    then obtain asx' where "targetnode a -asx'→* m" and "nx  set (sourcenodes asx')"
      by blast
    show False
    proof(cases "nx  set(sourcenodes asx'). nx  ?WOD_BS")
      case True
      with targetnode a -asx'→* m m  obs (sourcenode a) (?WOD_BS) 
      have "m  obs (targetnode a) ?WOD_BS" by(fastforce intro:obs_elem elim:obsE)
      with nx  m ‹obs (targetnode a) (?WOD_BS) = {nx} show False by simp
    next
      case False
      hence "nx  set(sourcenodes asx'). nx  ?WOD_BS" by blast
      then obtain nx' ns ns' where "sourcenodes asx' = ns@nx'#ns'" and "nx'  ?WOD_BS"
        and "nx  set ns. nx  ?WOD_BS" by(fastforce elim!:split_list_first_propE)
      from ‹sourcenodes asx' = ns@nx'#ns' obtain ax ai ai' 
        where [simp]:"asx' = ai@ax#ai'" "ns = sourcenodes ai" "nx' = sourcenode ax"
        by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
      from targetnode a -asx'→* m have "targetnode a -ai→* sourcenode ax"
        by(fastforce dest:path_split)
      with nx'  ?WOD_BS nx  set ns. nx  ?WOD_BS 
      have "nx'  obs (targetnode a) ?WOD_BS" by(fastforce intro:obs_elem)
      with ‹obs (targetnode a) (?WOD_BS) = {nx} have "nx' = nx" by simp
      with nx  set (sourcenodes asx') show False by(simp add:sourcenodes_def)
    qed
  qed
  with nx  m sourcenode a -as1→* nx m  set(sourcenodes as1) 
    sourcenode a -as2→* m nx  set(sourcenodes as2) valid_edge a 
    targetnode a -asx→* nx
  have "sourcenode a wod nx,m" by(simp add:wod_def,blast)
  with nx  obs (sourcenode a) (?WOD_BS) m  obs (sourcenode a) (?WOD_BS) 
  have "sourcenode a  ?WOD_BS" by(fastforce elim:cd_closed elim:obsE)
  with sourcenode a  ?WOD_BS show False by simp
qed


lemma WODBackwardSliceCorrect:
  "BackwardSlice sourcenode targetnode kind valid_edge
        (_Entry_) Def Use state_val wod_backward_slice"
proof(unfold_locales)
  fix n S assume "n  wod_backward_slice S"
  thus "valid_node n" by(rule wod_backward_slice_valid_node)
next
  fix n S assume "valid_node n" and "n  S"
  thus "n  wod_backward_slice S" by(rule refl)
next
  fix n' S n V assume "n'  wod_backward_slice S" "n influences V in n'"
  thus "n  wod_backward_slice S"
    by -(rule dd_closed)
next
  fix n S
  have "(m. obs n (wod_backward_slice S) = {m})  
    obs n (wod_backward_slice S) = {}" 
    by(rule obs_singleton)
  thus "finite (obs n (wod_backward_slice S))" by fastforce
next
  fix n S 
  have "(m. obs n (wod_backward_slice S) = {m})  obs n (wod_backward_slice S) = {}" 
    by(rule obs_singleton)
  thus "card (obs n (wod_backward_slice S))  1" by fastforce
qed

end

end

Theory ControlDependenceRelations

section ‹Relations between control dependences›

theory ControlDependenceRelations 
  imports WeakOrderDependence StandardControlDependence 
begin

context StrongPostdomination begin

lemma standard_control_implies_weak_order: 
  assumes "n controlss n'" shows "n wod n',(_Exit_)"
proof -
  from n controlss n' obtain as a a' as' where "as = a#as'"
    and "n'  set(sourcenodes as)" and "n -as→* n'"
    and "n' postdominates (targetnode a)"
    and "valid_edge a'" and "sourcenode a' = n"
    and "¬ n' postdominates (targetnode a')" 
    by(auto simp:standard_control_dependence_def)
  from n -as→* n' as = a#as' have "sourcenode a = n" by(auto elim:path.cases)
  from n -as→* n' as = a#as' n'  set(sourcenodes as) have "n  n'"
    by(induct rule:path.induct,auto simp:sourcenodes_def)
  from n -as→* n' as = a#as' have "valid_edge a"
    by(auto elim:path.cases)
  from n controlss n' have "n'  (_Exit_)"
    by(fastforce dest:Exit_not_standard_control_dependent)
  from n -as→* n' have "(_Exit_)  set (sourcenodes as)" by fastforce
  from n -as→* n' have "valid_node n" and "valid_node n'"
    by(auto dest:path_valid_node)
  with ¬ n' postdominates (targetnode a') valid_edge a'
  obtain asx where "targetnode a' -asx→* (_Exit_)" and "n'  set(sourcenodes asx)"
    by(auto simp:postdominate_def)
  with valid_edge a' sourcenode a' = n have "n -a'#asx→* (_Exit_)"
    by(fastforce intro:Cons_path)
  with n  n' sourcenode a' = n n'  set(sourcenodes asx)
  have "n'  set(sourcenodes (a'#asx))" by(simp add:sourcenodes_def)
  from n' postdominates (targetnode a) 
  obtain asx' where "targetnode a -asx'→* n'" by(erule postdominate_implies_path)
  from n' postdominates (targetnode a)
  have "as'. targetnode a -as'→* (_Exit_)  n'  set(sourcenodes as')"
    by(auto simp:postdominate_def)
  with n'  (_Exit_) n -as→* n' (_Exit_)  set (sourcenodes as)
    n -a'#asx→* (_Exit_) n'  set(sourcenodes (a'#asx))
    valid_edge a sourcenode a = n targetnode a -asx'→* n'
  show ?thesis by(auto simp:wod_def)
qed

end

end

Theory Com

chapter ‹Instantiating the Framework with a simple While-Language›

section ‹Commands›

theory Com imports Main begin

subsection ‹Variables and Values›

type_synonym vname = string ― ‹names for variables›

datatype val
  = Bool bool      ― ‹Boolean value›
  | Intg int       ― ‹integer value› 

abbreviation "true == Bool True"
abbreviation "false == Bool False"

subsection ‹Expressions and Commands›

datatype bop = Eq | And | Less | Add | Sub     ― ‹names of binary operations›

datatype expr
  = Val val                                          ― ‹value›
  | Var vname                                        ― ‹local variable›
  | BinOp expr bop expr    ("_ «_» _" [80,0,81] 80)  ― ‹binary operation›


fun binop :: "bop  val  val  val option"
where "binop Eq v1 v2               = Some(Bool(v1 = v2))"
  | "binop And (Bool b1) (Bool b2)  = Some(Bool(b1  b2))"
  | "binop Less (Intg i1) (Intg i2) = Some(Bool(i1 < i2))"
  | "binop Add (Intg i1) (Intg i2)  = Some(Intg(i1 + i2))"
  | "binop Sub (Intg i1) (Intg i2)  = Some(Intg(i1 - i2))"
  | "binop bop v1 v2                = None"


datatype cmd
  = Skip
  | LAss vname expr        ("_:=_" [70,70] 70)  ― ‹local assignment›
  | Seq cmd cmd            ("_;;/ _" [61,60] 60)
  | Cond expr cmd cmd      ("if '(_') _/ else _" [80,79,79] 70)
  | While expr cmd         ("while '(_') _" [80,79] 70)


fun num_inner_nodes :: "cmd  nat" ("#:_")
where "#:Skip              = 1"
  | "#:(V:=e)              = 2"       (* zusätzlicher Skip-Knoten *)
  | "#:(c1;;c2)            = #:c1 + #:c2"
  | "#:(if (b) c1 else c2) = #:c1 + #:c2 + 1"
  | "#:(while (b) c)       = #:c + 2" (* zusätzlicher Skip-Knoten *)
  


lemma num_inner_nodes_gr_0:"#:c > 0"
by(induct c) auto

lemma [dest]:"#:c = 0  False"
by(induct c) auto

subsection ‹The state›

type_synonym state = "vname  val"

fun "interpret" :: "expr  state  val option"
where Val: "interpret (Val v) s = Some v"
  | Var: "interpret (Var V) s = s V"
  | BinOp: "interpret (e1«bop»e2) s = 
    (case interpret e1 s of None  None
                         | Some v1  (case interpret e2 s of None  None
                                                           | Some v2  (
      case binop bop v1 v2 of None  None | Some v  Some v)))"

end

Theory WCFG

section ‹CFG›

theory WCFG imports Com "../Basic/BasicDefs" begin

subsection‹CFG nodes›

datatype w_node = Node nat ("'('_ _ '_')")
  | Entry ("'('_Entry'_')")
  | Exit ("'('_Exit'_')") 

fun label_incr :: "w_node  nat  w_node" ("_  _" 60)
where "(_ l _)  i = (_ l + i _)"
  | "(_Entry_)  i = (_Entry_)"
  | "(_Exit_)  i  = (_Exit_)"


lemma Exit_label_incr [dest]: "(_Exit_) = n  i  n = (_Exit_)"
  by(cases n,auto)

lemma label_incr_Exit [dest]: "n  i = (_Exit_)  n = (_Exit_)"
  by(cases n,auto)

lemma Entry_label_incr [dest]: "(_Entry_) = n  i  n = (_Entry_)"
  by(cases n,auto)

lemma label_incr_Entry [dest]: "n  i = (_Entry_)  n = (_Entry_)"
  by(cases n,auto)

lemma label_incr_inj:
  "n  c = n'  c  n = n'"
by(cases n)(cases n',auto)+

lemma label_incr_simp:"n  i = m  (i + j)  n = m  j"
by(cases n,auto,cases m,auto)

lemma label_incr_simp_rev:"m  (j + i) = n  i  m  j = n"
by(cases n,auto,cases m,auto)

lemma label_incr_start_Node_smaller:
  "(_ l _) = n  i  n = (_(l - i)_)"
by(cases n,auto)

lemma label_incr_ge:"(_ l _) = n  i  l  i"
by(cases n) auto

lemma label_incr_0 [dest]:
  "(_0_) = n  i; i > 0  False" 
by(cases n) auto

lemma label_incr_0_rev [dest]:
  "n  i = (_0_); i > 0  False" 
by(cases n) auto

subsection‹CFG edges›

type_synonym w_edge = "(w_node × state edge_kind × w_node)"

inductive While_CFG :: "cmd  w_node  state edge_kind  w_node  bool"
  ("_  _ -_ _")
where

WCFG_Entry_Exit:
  "prog  (_Entry_) -(λs. False) (_Exit_)"

| WCFG_Entry:
  "prog  (_Entry_) -(λs. True) (_0_)"

| WCFG_Skip: 
  "Skip  (_0_) -id (_Exit_)"

| WCFG_LAss: 
  "V:=e  (_0_) -(λs. s(V:=(interpret e s))) (_1_)"

| WCFG_LAssSkip:
  "V:=e  (_1_) -id (_Exit_)"

| WCFG_SeqFirst:
  "c1  n -et n'; n'  (_Exit_)  c1;;c2  n -et n'"

| WCFG_SeqConnect: 
  "c1  n -et (_Exit_); n  (_Entry_)  c1;;c2  n -et (_0_)  #:c1"

| WCFG_SeqSecond: 
  "c2  n -et n'; n  (_Entry_)  c1;;c2  n  #:c1 -et n'  #:c1"

| WCFG_CondTrue:
    "if (b) c1 else c2  (_0_) -(λs. interpret b s = Some true) (_0_)  1"

| WCFG_CondFalse:
    "if (b) c1 else c2  (_0_) -(λs. interpret b s = Some false) (_0_)  (#:c1 + 1)"

| WCFG_CondThen:
  "c1  n -et n'; n  (_Entry_)  if (b) c1 else c2  n  1 -et n'  1"

| WCFG_CondElse:
  "c2  n -et n'; n  (_Entry_) 
   if (b) c1 else c2  n  (#:c1 + 1) -et n'  (#:c1 + 1)"

| WCFG_WhileTrue:
    "while (b) c'  (_0_) -(λs. interpret b s = Some true) (_0_)  2"

| WCFG_WhileFalse:
    "while (b) c'  (_0_) -(λs. interpret b s = Some false) (_1_)"

| WCFG_WhileFalseSkip:
  "while (b) c'  (_1_) -id (_Exit_)"

| WCFG_WhileBody:
  "c'  n -et n'; n  (_Entry_); n'  (_Exit_) 
   while (b) c'  n  2 -et n'  2"

| WCFG_WhileBodyExit:
  "c'  n -et (_Exit_); n  (_Entry_)  while (b) c'  n  2 -et (_0_)"

lemmas WCFG_intros = While_CFG.intros[split_format (complete)]
lemmas WCFG_elims = While_CFG.cases[split_format (complete)]
lemmas WCFG_induct = While_CFG.induct[split_format (complete)]


subsection ‹Some lemmas about the CFG›

lemma WCFG_Exit_no_sourcenode [dest]:
  "prog  (_Exit_) -et n'  False"
by(induct prog n"(_Exit_)" et n' rule:WCFG_induct,auto)


lemma WCFG_Entry_no_targetnode [dest]:
  "prog  n -et (_Entry_)  False"
by(induct prog n et n'"(_Entry_)" rule:WCFG_induct,auto)


lemma WCFG_sourcelabel_less_num_nodes:
  "prog  (_ l _) -et n'  l < #:prog"
proof(induct prog "(_ l _)" et n' arbitrary:l rule:WCFG_induct)
  case (WCFG_SeqFirst c1 et n' c2)
  from l < #:c1 show ?case by simp
next
  case (WCFG_SeqConnect c1 et c2)
  from l < #:c1 show ?case by simp
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = l. n = (_ l _)  l < #:c2
  from n  #:c1 = (_ l _) obtain l' where "n = (_ l' _)" by(cases n) auto
  from IH[OF this] have "l' < #:c2" .
  with n  #:c1 = (_ l _) n = (_ l' _) show ?case by simp
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = l. n = (_ l _)  l < #:c1
  from n  1 = (_ l _) obtain l' where "n = (_ l' _)" by(cases n) auto
  from IH[OF this] have "l' < #:c1" .
  with n  1 = (_ l _) n = (_ l' _) show ?case by simp
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = l. n = (_ l _)  l < #:c2
  from n  (#:c1 + 1) = (_ l _) obtain l' where "n = (_ l' _)" by(cases n) auto
  from IH[OF this] have "l' < #:c2" .
  with n  (#:c1 + 1) = (_ l _) n = (_ l' _) show ?case by simp
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = l. n = (_ l _)  l < #:c'
  from n  2 = (_ l _) obtain l' where "n = (_ l' _)" by(cases n) auto
  from IH[OF this] have "l' < #:c'" .
  with n  2 = (_ l _) n = (_ l' _) show ?case by simp
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = l. n = (_ l _)  l < #:c'
  from n  2 = (_ l _) obtain l' where "n = (_ l' _)" by(cases n) auto
  from IH[OF this] have "l' < #:c'" .
  with n  2 = (_ l _) n = (_ l' _) show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)


lemma WCFG_targetlabel_less_num_nodes:
  "prog  n -et (_ l _)  l < #:prog"
proof(induct prog n et "(_ l _)" arbitrary:l rule:WCFG_induct)
  case (WCFG_SeqFirst c1 n et c2)
  from l < #:c1 show ?case by simp
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = l. n' = (_ l _)  l < #:c2
  from n'  #:c1 = (_ l _) obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c2" .
  with n'  #:c1 = (_ l _) n' = (_ l' _) show ?case by simp
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = l. n' = (_ l _)  l < #:c1
  from n'  1 = (_ l _) obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c1" .
  with n'  1 = (_ l _) n' = (_ l' _) show ?case by simp
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = l. n' = (_ l _)  l < #:c2
  from n'  (#:c1 + 1) = (_ l _) obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c2" .
  with n'  (#:c1 + 1) = (_ l _) n' = (_ l' _) show ?case by simp
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = l. n' = (_ l _)  l < #:c'
  from n'  2 = (_ l _) obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c'" .
  with n'  2 = (_ l _) n' = (_ l' _) show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)


lemma WCFG_EntryD:
  "prog  (_Entry_) -et n'
   (n' = (_Exit_)  et = (λs. False))  (n' = (_0_)  et = (λs. True))"
by(induct prog n"(_Entry_)" et n' rule:WCFG_induct,auto)


(*<*)declare One_nat_def [simp del] add_2_eq_Suc' [simp del](*>*)

lemma WCFG_edge_det:
  "prog  n -et n'; prog  n -et' n'  et = et'"
proof(induct rule:WCFG_induct)
  case WCFG_Entry_Exit thus ?case by(fastforce dest:WCFG_EntryD)
next
  case WCFG_Entry thus ?case by(fastforce dest:WCFG_EntryD)
next
  case WCFG_Skip thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_LAss thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_LAssSkip thus ?case by(fastforce elim:WCFG_elims)
next
  case (WCFG_SeqFirst c1 n et n' c2)
  note IH = c1  n -et' n'  et = et'
  from c1  n -et n' n'  (_Exit_) obtain l where "n' = (_ l _)"
    by (cases n') auto
  with c1  n -et n' have "l < #:c1" 
    by(fastforce intro:WCFG_targetlabel_less_num_nodes)
  with c1;;c2  n -et' n' n' = (_ l _) have "c1  n -et' n'"
    by(fastforce elim:WCFG_elims intro:WCFG_intros dest:label_incr_ge)
  from IH[OF this] show ?case .
next
  case (WCFG_SeqConnect c1 n et c2)
  note IH = c1  n -et' (_Exit_)  et = et'
  from c1  n -et (_Exit_) n  (_Entry_) obtain l where "n = (_ l _)"
    by (cases n) auto
  with c1  n -et (_Exit_) have "l < #:c1"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with c1;;c2  n -et' (_ 0 _)  #:c1 n = (_ l _) have "c1  n -et' (_Exit_)"
    by(fastforce elim:WCFG_elims dest:WCFG_targetlabel_less_num_nodes label_incr_ge)
  from IH[OF this] show ?case .
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = c2  n -et' n'  et = et'
  from c2  n -et n' n  (_Entry_) obtain l where "n = (_ l _)"
    by (cases n) auto
  with c2  n -et n' have "l < #:c2"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with c1;;c2  n  #:c1 -et' n'  #:c1 n = (_ l _) have "c2  n -et' n'"
    by -(erule WCFG_elims,(fastforce dest:WCFG_sourcelabel_less_num_nodes label_incr_ge
                                    dest!:label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case WCFG_CondTrue thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_CondFalse thus ?case by(fastforce elim:WCFG_elims)
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = c1  n -et' n'  et = et'
  from c1  n -et n' n  (_Entry_) obtain l where "n = (_ l _)"
    by (cases n) auto
  with c1  n -et n' have "l < #:c1"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with if (b) c1 else c2  n  1 -et' n'  1 n = (_ l _)
  have "c1  n -et' n'"
    by -(erule WCFG_elims,(fastforce dest:label_incr_ge label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = c2  n -et' n'  et = et'
  from c2  n -et n' n  (_Entry_) obtain l where "n = (_ l _)"
    by (cases n) auto
  with c2  n -et n' have "l < #:c2"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with if (b) c1 else c2  n  (#:c1 + 1) -et' n'  (#:c1 + 1) n = (_ l _)
  have "c2  n -et' n'"
    by -(erule WCFG_elims,(fastforce dest:WCFG_sourcelabel_less_num_nodes 
                             label_incr_inj label_incr_ge label_incr_simp_rev)+)
  from IH[OF this] show ?case .
next
  case WCFG_WhileTrue thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_WhileFalse thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_WhileFalseSkip thus ?case by(fastforce elim:WCFG_elims)
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = c'  n -et' n'  et = et'
  from c'  n -et n' n  (_Entry_) obtain l where "n = (_ l _)"
    by (cases n) auto
  moreover
  with c'  n -et n' have "l < #:c'"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  moreover
  from c'  n -et n' n'  (_Exit_) obtain l' where "n' = (_ l' _)"
    by (cases n') auto
  moreover
  with c'  n -et n' have "l' < #:c'"
    by(fastforce intro:WCFG_targetlabel_less_num_nodes)
  ultimately have "c'  n -et' n'" using while (b) c'  n  2 -et' n'  2
    by(fastforce elim:WCFG_elims dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = c'  n -et' (_Exit_)  et = et'
  from c'  n -et (_Exit_) n  (_Entry_) obtain l where "n = (_ l _)"
    by (cases n) auto
  with c'  n -et (_Exit_) have "l < #:c'"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with while (b) c'  n  2 -et' (_0_) n = (_ l _)
  have "c'  n -et' (_Exit_)"
    by -(erule WCFG_elims,auto dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
qed

(*<*)declare One_nat_def [simp] add_2_eq_Suc' [simp](*>*)

lemma less_num_nodes_edge_Exit:
  obtains l et where "l < #:prog" and "prog  (_ l _) -et (_Exit_)"
proof -
  have "l et. l < #:prog  prog  (_ l _) -et (_Exit_)"
  proof(induct prog)
    case Skip
    have "0 < #:Skip" by simp
    moreover have "Skip  (_0_) -id (_Exit_)" by(rule WCFG_Skip)
    ultimately show ?case by blast
  next
    case (LAss V e)
    have "1 < #:(V:=e)" by simp
    moreover have "V:=e  (_1_) -id (_Exit_)" by(rule WCFG_LAssSkip)
    ultimately show ?case by blast
  next
    case (Seq prog1 prog2)
    from l et. l < #:prog2  prog2  (_ l _) -et (_Exit_)
    obtain l et where "l < #:prog2" and "prog2  (_ l _) -et (_Exit_)"
      by blast
    from prog2  (_ l _) -et (_Exit_) 
    have "prog1;;prog2  (_ l _)  #:prog1 -et (_Exit_)  #:prog1"
      by(fastforce intro:WCFG_SeqSecond)
    with l < #:prog2 show ?case by(rule_tac x="l + #:prog1" in exI,auto)
  next
    case (Cond b prog1 prog2)
    from l et. l < #:prog1  prog1  (_ l _) -et (_Exit_)
    obtain l et where "l < #:prog1" and "prog1  (_ l _) -et (_Exit_)"
      by blast
    from prog1  (_ l _) -et (_Exit_)
    have "if (b) prog1 else prog2  (_ l _)  1 -et (_Exit_)  1"
      by(fastforce intro:WCFG_CondThen)
    with l < #:prog1 show ?case by(rule_tac x="l + 1" in exI,auto)
  next
    case (While b prog')
    have "1 < #:(while (b) prog')" by simp
    moreover have "while (b) prog'  (_1_) -id (_Exit_)"
      by(rule WCFG_WhileFalseSkip)
    ultimately show ?case by blast
  qed
  with that show ?thesis by blast
qed


lemma less_num_nodes_edge:
  "l < #:prog  n et. prog  n -et (_ l _)  prog  (_ l _) -et n"
proof(induct prog arbitrary:l)
  case Skip
  from l < #:Skip› have "l = 0" by simp
  hence "Skip  (_ l _) -id (_Exit_)" by(fastforce intro:WCFG_Skip)
  thus ?case by blast
next
  case (LAss V e)
  from l < #:V:=e have "l = 0  l = 1" by auto
  thus ?case
  proof
    assume "l = 0"
    hence "V:=e  (_Entry_) -(λs. True) (_ l _)" by(fastforce intro:WCFG_Entry)
    thus ?thesis by blast
  next
    assume "l = 1"
    hence "V:=e  (_ l _) -id (_Exit_)" by(fastforce intro:WCFG_LAssSkip)
    thus ?thesis by blast
  qed
next
  case (Seq prog1 prog2)
  note IH1 = l. l < #:prog1  
              n et. prog1  n -et (_ l _)  prog1  (_ l _) -et n
  note IH2 = l. l < #:prog2  
              n et. prog2  n -et (_ l _)  prog2  (_ l _) -et n
  show ?case
  proof(cases "l < #:prog1")
    case True
    from IH1[OF this] obtain n et 
      where "prog1  n -et (_ l _)  prog1  (_ l _) -et n" by blast
    thus ?thesis
    proof
      assume "prog1  n -et (_ l _)"
      hence "prog1;; prog2  n -et (_ l _)" by(fastforce intro:WCFG_SeqFirst)
      thus ?thesis by blast
    next
      assume edge:"prog1  (_ l _) -et n"
      show ?thesis
      proof(cases "n = (_Exit_)")
        case True
        with edge have "prog1;; prog2  (_ l _) -et (_0_)  #:prog1"
          by(fastforce intro:WCFG_SeqConnect)
        thus ?thesis by blast
      next
        case False
        with edge have "prog1;; prog2  (_ l _) -et n"
          by(fastforce intro:WCFG_SeqFirst)
        thus ?thesis by blast
      qed
    qed
  next
    case False
    hence "#:prog1  l" by simp
    then obtain l' where "l = l' + #:prog1" and "l' = l - #:prog1" by simp
    from l = l' + #:prog1 l < #:prog1;; prog2 have "l' < #:prog2" by simp
    from IH2[OF this] obtain n et
      where "prog2  n -et (_ l' _)  prog2  (_ l' _) -et n" by blast
    thus ?thesis
    proof
      assume "prog2  n -et (_ l' _)"
      show ?thesis
      proof(cases "n = (_Entry_)")
        case True
        with prog2  n -et (_ l' _) have "l' = 0" by(auto dest:WCFG_EntryD)
        obtain l'' et'' where "l'' < #:prog1" 
          and "prog1  (_ l'' _) -et'' (_Exit_)"
          by(erule less_num_nodes_edge_Exit)
        hence "prog1;;prog2  (_ l'' _) -et'' (_0_)  #:prog1"
          by(fastforce intro:WCFG_SeqConnect)
        with l' = 0 l = l' + #:prog1 show ?thesis by simp blast
      next
        case False
        with prog2  n -et (_ l' _)
        have "prog1;;prog2  n  #:prog1 -et (_ l' _)  #:prog1"
          by(fastforce intro:WCFG_SeqSecond)
        with l = l' + #:prog1 show ?thesis  by simp blast
      qed
    next
      assume "prog2  (_ l' _) -et n"
      hence "prog1;;prog2  (_ l' _)  #:prog1 -et n  #:prog1"
        by(fastforce intro:WCFG_SeqSecond)
      with l = l' + #:prog1 show ?thesis  by simp blast
    qed
  qed
next
  case (Cond b prog1 prog2)
  note IH1 = l. l < #:prog1  
              n et. prog1  n -et (_ l _)  prog1  (_ l _) -et n
  note IH2 = l. l < #:prog2  
              n et. prog2  n -et (_ l _)  prog2  (_ l _) -et n
  show ?case
  proof(cases "l = 0")
    case True
    have "if (b) prog1 else prog2  (_Entry_) -(λs. True) (_0_)"
      by(rule WCFG_Entry)
    with True show ?thesis by simp blast
  next
    case False
    hence "0 < l" by simp
    then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
    thus ?thesis
    proof(cases "l' < #:prog1")
      case True
      from IH1[OF this] obtain n et 
        where "prog1  n -et (_ l' _)  prog1  (_ l' _) -et n" by blast
      thus ?thesis
      proof
        assume edge:"prog1  n -et (_ l' _)"
        show ?thesis
        proof(cases "n = (_Entry_)")
          case True
          with edge have "l' = 0" by(auto dest:WCFG_EntryD)
          have "if (b) prog1 else prog2  (_0_) -(λs. interpret b s = Some true) 
                                          (_0_)  1"
            by(rule WCFG_CondTrue)
          with l' = 0 l = l' + 1 show ?thesis by simp blast
        next
          case False
          with edge have "if (b) prog1 else prog2  n  1 -et (_ l' _)  1"
            by(fastforce intro:WCFG_CondThen)
          with l = l' + 1 show ?thesis by simp blast
        qed
      next
        assume "prog1  (_ l' _) -et n"
        hence "if (b) prog1 else prog2  (_ l' _)  1 -et n  1"
          by(fastforce intro:WCFG_CondThen)
        with l = l' + 1 show ?thesis by simp blast
      qed
    next
      case False
      hence "#:prog1  l'" by simp
      then obtain l'' where "l' = l'' + #:prog1" and "l'' = l' - #:prog1"
        by simp
      from l' = l'' + #:prog1 l = l' + 1 l < #:(if (b) prog1 else prog2)
      have "l'' < #:prog2" by simp
      from IH2[OF this] obtain n et 
        where "prog2  n -et (_ l'' _)  prog2  (_ l'' _) -et n" by blast
      thus ?thesis
      proof
        assume "prog2  n -et (_ l'' _)"
        show ?thesis
        proof(cases "n = (_Entry_)")
          case True
          with prog2  n -et (_ l'' _) have "l'' = 0" by(auto dest:WCFG_EntryD)
          have "if (b) prog1 else prog2  (_0_) -(λs. interpret b s = Some false) 
                                          (_0_)  (#:prog1 + 1)"
            by(rule WCFG_CondFalse)
          with l'' = 0 l' = l'' + #:prog1 l = l' + 1 show ?thesis by simp blast
        next
          case False
          with prog2  n -et (_ l'' _)
          have "if (b) prog1 else prog2  n  (#:prog1 + 1) -et 
                                          (_ l'' _)  (#:prog1 + 1)"
            by(fastforce intro:WCFG_CondElse)
          with l = l' + 1 l' = l'' + #:prog1 show ?thesis by simp blast
        qed
      next
        assume "prog2  (_ l'' _) -et n"
        hence "if (b) prog1 else prog2  (_ l'' _)  (#:prog1 + 1) -et 
                                         n  (#:prog1 + 1)"
          by(fastforce intro:WCFG_CondElse)
        with l = l' + 1 l' = l'' + #:prog1 show ?thesis by simp blast
      qed
    qed
  qed
next
  case (While b prog')
  note IH = l. l < #:prog' 
              n et. prog'  n -et (_ l _)  prog'  (_ l _) -et n
  show ?case
  proof(cases "l < 1")
    case True
    have "while (b) prog'  (_Entry_) -(λs. True) (_0_)" by(rule WCFG_Entry)
    with True show ?thesis by simp blast
  next
    case False
    hence "1  l" by simp
    thus ?thesis
    proof(cases "l < 2")
      case True
      with 1  l have "l = 1" by simp
      have "while (b) prog'  (_0_) -(λs. interpret b s = Some false) (_1_)"
        by(rule WCFG_WhileFalse)
      with l = 1 show ?thesis by simp blast
    next
      case False
      with 1  l have "2  l" by simp
      then obtain l' where "l = l' + 2" and "l' = l - 2" 
        by(simp del:add_2_eq_Suc')
      from l = l' + 2 l < #:while (b) prog' have "l' < #:prog'" by simp
      from IH[OF this] obtain n et 
        where "prog'  n -et (_ l' _)  prog'  (_ l' _) -et n" by blast
      thus ?thesis
      proof
        assume "prog'  n -et (_ l' _)"
        show ?thesis
        proof(cases "n = (_Entry_)")
          case True
          with prog'  n -et (_ l' _) have "l' = 0" by(auto dest:WCFG_EntryD)
          have "while (b) prog'  (_0_) -(λs. interpret b s = Some true) 
                                  (_0_)  2"
            by(rule WCFG_WhileTrue)
          with l' = 0 l = l' + 2 show ?thesis by simp blast
        next
          case False
          with prog'  n -et (_ l' _)
          have "while (b) prog'  n  2 -et (_ l' _)  2"
            by(fastforce intro:WCFG_WhileBody)
          with l = l' + 2 show ?thesis by simp blast
        qed
      next
        assume "prog'  (_ l' _) -et n"
        show ?thesis
        proof(cases "n = (_Exit_)")
          case True
          with prog'  (_ l' _) -et n
          have "while (b) prog'  (_ l' _)  2 -et (_0_)"
            by(fastforce intro:WCFG_WhileBodyExit)
          with l = l' + 2 show ?thesis by simp blast
        next
          case False
          with prog'  (_ l' _) -et n
          have "while (b) prog'  (_ l' _)  2 -et n  2"
            by(fastforce intro:WCFG_WhileBody)
          with l = l' + 2 show ?thesis by simp blast
        qed
      qed
    qed
  qed
qed


(*<*)declare One_nat_def [simp del](*>*)

lemma WCFG_deterministic:
  "prog  n1 -et1 n1'; prog  n2 -et2 n2'; n1 = n2; n1'  n2'
   Q Q'. et1 = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
proof(induct arbitrary:n2 n2' rule:WCFG_induct)
  case (WCFG_Entry_Exit prog)
  from prog  n2 -et2 n2' (_Entry_) = n2 (_Exit_)  n2'
  have "et2 = (λs. True)" by(fastforce dest:WCFG_EntryD)
  thus ?case by simp
next
  case (WCFG_Entry prog)
  from prog  n2 -et2 n2' (_Entry_) = n2 (_0_)  n2'
  have "et2 = (λs. False)" by(fastforce dest:WCFG_EntryD)
  thus ?case by simp
next
  case WCFG_Skip
  from ‹Skip  n2 -et2 n2' (_0_) = n2 (_Exit_)  n2'
  have False by(fastforce elim:WCFG.While_CFG.cases)
  thus ?case by simp
next
  case (WCFG_LAss V e)
  from V:=e  n2 -et2 n2' (_0_) = n2 (_1_)  n2'
  have False by -(erule WCFG.While_CFG.cases,auto)
  thus ?case by simp
next
  case (WCFG_LAssSkip V e)
  from V:=e  n2 -et2 n2' (_1_) = n2 (_Exit_)  n2'
  have False by -(erule WCFG.While_CFG.cases,auto)
  thus ?case by simp
next
  case (WCFG_SeqFirst c1 n et n' c2)
  note IH = n2 n2'. c1  n2 -et2 n2'; n = n2; n'  n2'
   Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from c1;;c2  n2 -et2 n2' c1  n -et n' n = n2 n'  n2'
  have "c1  n2 -et2 n2'  (c1  n2 -et2 (_Exit_)  n2' = (_0_)  #:c1)"
    apply hypsubst_thin apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
    by(case_tac n,auto dest:WCFG_sourcelabel_less_num_nodes)+
  thus ?case
  proof
    assume "c1  n2 -et2 n2'"
    from IH[OF this n = n2 n'  n2'] show ?case .
  next
    assume "c1  n2 -et2 (_Exit_)  n2' = (_0_)  #:c1"
    hence edge:"c1  n2 -et2 (_Exit_)" and n2':"n2' = (_0_)  #:c1" by simp_all
    from IH[OF edge n = n2 n'  (_Exit_)] show ?case .
  qed
next
  case (WCFG_SeqConnect c1 n et c2)
  note IH = n2 n2'. c1  n2 -et2 n2'; n = n2; (_Exit_)  n2'
   Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from c1;;c2  n2 -et2 n2' c1  n -et (_Exit_) n = n2 n  (_Entry_)
    (_0_)  #:c1  n2' have "c1  n2 -et2 n2'  (_Exit_)  n2'"
    apply hypsubst_thin apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
    by(case_tac n,auto dest:WCFG_sourcelabel_less_num_nodes)+
  from IH[OF this[THEN conjunct1] n = n2 this[THEN conjunct2]]
  show ?case .
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = n2 n2'. c2  n2 -et2 n2'; n = n2; n'  n2'
   Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from c1;;c2  n2 -et2 n2' c2  n -et n' n  #:c1 = n2
    n'  #:c1  n2' n  (_Entry_)
  obtain nx where "c2  n -et2 nx  nx  #:c1 = n2'"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
      apply(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
     apply(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  with n'  #:c1  n2' have edge:"c2  n -et2 nx" and neq:"n'  nx"
    by auto
  from IH[OF edge _ neq] show ?case by simp
next
  case (WCFG_CondTrue b c1 c2)
  from if (b) c1 else c2  n2 -et2 n2' (_0_) = n2 (_0_)  1  n2'
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_CondFalse b c1 c2)
  from if (b) c1 else c2  n2 -et2 n2' (_0_) = n2 (_0_)  #:c1 + 1  n2'
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = n2 n2'. c1  n2 -et2 n2'; n = n2; n'  n2'
     Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from if (b) c1 else c2  n2 -et2 n2' c1  n -et n' n  (_Entry_) 
    n  1 = n2 n'  1  n2'
  obtain nx where "c1  n -et2 nx  n'  nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
     apply(drule label_incr_inj) apply auto
    apply(drule label_incr_simp_rev[OF sym])
    by(case_tac na,auto dest:WCFG_sourcelabel_less_num_nodes)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = n2 n2'. c2  n2 -et2 n2'; n = n2; n'  n2'
     Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from if (b) c1 else c2  n2 -et2 n2' c2  n -et n' n  (_Entry_) 
    n  #:c1 + 1 = n2 n'  #:c1 + 1  n2'
  obtain nx where "c2  n -et2 nx  n'  nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
     apply(drule label_incr_simp_rev)
     apply(case_tac na,auto,cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (WCFG_WhileTrue b c')
  from while (b) c'  n2 -et2 n2' (_0_) = n2 (_0_)  2  n2'
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_WhileFalse b c')
  from while (b) c'  n2 -et2 n2' (_0_) = n2 (_1_)  n2'
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_WhileFalseSkip b c')
  from while (b) c'  n2 -et2 n2' (_1_) = n2 (_Exit_)  n2'
  show ?case by -(erule WCFG.While_CFG.cases,auto dest:label_incr_ge)
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = n2 n2'. c'  n2 -et2 n2'; n = n2; n'  n2'
     Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from while (b) c'  n2 -et2 n2' c'  n -et n' n  (_Entry_)
    n'  (_Exit_) n  2 = n2 n'  2  n2'
  obtain nx where "c'  n -et2 nx  n'  nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
      apply(fastforce dest:label_incr_ge[OF sym])
     apply(fastforce dest:label_incr_inj)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = n2 n2'. c'  n2 -et2 n2'; n = n2; (_Exit_)  n2'
     Q Q'. et = (Q)  et2 = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from while (b) c'  n2 -et2 n2' c'  n -et (_Exit_) n  (_Entry_)
    n  2 = n2 (_0_)  n2'
  obtain nx where "c'  n -et2 nx  (_Exit_)  nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
     apply(fastforce dest:label_incr_ge[OF sym])
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
qed

(*<*)declare One_nat_def [simp](*>*)

end

Theory Interpretation

section ‹Instantiate CFG locale with While CFG›

theory Interpretation imports 
  WCFG 
  "../Basic/CFGExit" 
begin

subsection ‹Instatiation of the CFG› locale›

abbreviation sourcenode :: "w_edge  w_node"
  where "sourcenode e  fst e"

abbreviation targetnode :: "w_edge  w_node"
  where "targetnode e  snd(snd e)"

abbreviation kind :: "w_edge  state edge_kind"
  where "kind e  fst(snd e)"


definition valid_edge :: "cmd  w_edge  bool"
  where "valid_edge prog a  prog  sourcenode a -kind a targetnode a"

definition valid_node ::"cmd  w_node  bool"
  where "valid_node prog n  
    (a. valid_edge prog a  (n = sourcenode a  n = targetnode a))"


lemma While_CFG_aux:
  "CFG sourcenode targetnode (valid_edge prog) Entry"
proof(unfold_locales)
  fix a assume "valid_edge prog a" and "targetnode a = (_Entry_)"
  obtain nx et nx' where "a = (nx,et,nx')" by (cases a) auto
  with ‹valid_edge prog a ‹targetnode a = (_Entry_) 
  have "prog  nx -et (_Entry_)" by(simp add:valid_edge_def)
  thus False by fastforce
next
  fix a a'
  assume assms:"valid_edge prog a" "valid_edge prog a'"
    "sourcenode a = sourcenode a'" "targetnode a = targetnode a'"
  obtain x et y where [simp]:"a = (x,et,y)" by (cases a) auto
  obtain x' et' y' where [simp]:"a' = (x',et',y')" by (cases a') auto
  from assms have "et = et'"
    by(fastforce intro:WCFG_edge_det simp:valid_edge_def)
  with ‹sourcenode a = sourcenode a' ‹targetnode a = targetnode a'
  show "a = a'" by simp
qed

interpretation While_CFG:
  CFG sourcenode targetnode kind "valid_edge prog" Entry
  for prog
  by(rule While_CFG_aux)


lemma While_CFGExit_aux:
  "CFGExit sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
  fix a assume "valid_edge prog a" and "sourcenode a = (_Exit_)"
  obtain nx et nx' where "a = (nx,et,nx')" by (cases a) auto
  with ‹valid_edge prog a ‹sourcenode a = (_Exit_) 
  have "prog  (_Exit_) -et nx'" by(simp add:valid_edge_def)
  thus False by fastforce
next
  have "prog  (_Entry_) -(λs. False) (_Exit_)" by(rule WCFG_Entry_Exit)
  thus "a. valid_edge prog a  sourcenode a = (_Entry_) 
            targetnode a = (_Exit_)  kind a = (λs. False)"
    by(fastforce simp:valid_edge_def)
qed

interpretation While_CFGExit:
  CFGExit sourcenode targetnode kind "valid_edge prog" Entry Exit
  for prog
by(rule While_CFGExit_aux)

end

Theory Labels

section ‹Labels›

theory Labels imports Com begin

text ‹Labels describe a mapping from the inner node label 
  to the matching command›

inductive labels :: "cmd  nat  cmd  bool"
where

Labels_Base:
  "labels c 0 c"

| Labels_LAss:
  "labels (V:=e) 1 Skip"

| Labels_Seq1: 
  "labels c1 l c  labels (c1;;c2) l (c;;c2)"

| Labels_Seq2: 
  "labels c2 l c  labels (c1;;c2) (l + #:c1) c"

| Labels_CondTrue:
  "labels c1 l c  labels (if (b) c1 else c2) (l + 1) c"

| Labels_CondFalse:
  "labels c2 l c  labels (if (b) c1 else c2) (l + #:c1 + 1) c"

| Labels_WhileBody:
  "labels c' l c  labels (while(b) c') (l + 2) (c;;while(b) c')"

| Labels_WhileExit:
  "labels (while(b) c') 1 Skip"

lemma label_less_num_inner_nodes:
  "labels c l c'  l < #:c"
proof(induct c arbitrary:l c')
  case Skip 
  from ‹labels Skip l c' show ?case by(fastforce elim:labels.cases)
next
  case (LAss V e) 
  from ‹labels (V:=e) l c' show ?case by(fastforce elim:labels.cases)
next
  case (Seq c1 c2)
  note IH1 = l c'. labels c1 l c'  l < #:c1
  note IH2 = l c'. labels c2 l c'  l < #:c2
  from ‹labels (c1;;c2) l c' IH1 IH2 show ?case
    by simp(erule labels.cases,auto,force)
next
  case (Cond b c1 c2)
  note IH1 = l c'. labels c1 l c'  l < #:c1
  note IH2 = l c'. labels c2 l c'  l < #:c2
  from ‹labels (if (b) c1 else c2) l c' IH1 IH2 show ?case
    by simp(erule labels.cases,auto,force)
next
  case (While b c)
  note IH = l c'. labels c l c'  l < #:c
  from ‹labels (while (b) c) l c' IH show ?case
    by simp(erule labels.cases,fastforce+)
qed


declare One_nat_def [simp del]

lemma less_num_inner_nodes_label:
  "l < #:c  c'. labels c l c'"
proof(induct c arbitrary:l)
  case Skip
  from l < #:Skip› have "l = 0" by simp
  thus ?case by(fastforce intro:Labels_Base)
next
  case (LAss V e)
  from l < #:(V:=e) have "l = 0  l = 1" by auto
  thus ?case by(auto intro:Labels_Base Labels_LAss)
next
  case (Seq c1 c2)
  note IH1 = l. l < #:c1  c'. labels c1 l c'
  note IH2 = l. l < #:c2  c'. labels c2 l c'
  show ?case
  proof(cases "l < #:c1")
    case True
    from IH1[OF this] obtain c' where "labels c1 l c'" by auto
    hence "labels (c1;;c2) l (c';;c2)" by(fastforce intro:Labels_Seq1)
    thus ?thesis by auto
  next
    case False
    hence "#:c1  l" by simp
    then obtain l' where "l = l' + #:c1" and "l' = l - #:c1" by simp
    from l = l' + #:c1 l < #:c1;;c2 have "l' < #:c2" by simp
    from IH2[OF this] obtain c' where "labels c2 l' c'" by auto
    with l = l' + #:c1 have "labels (c1;;c2) l c'" by(fastforce intro:Labels_Seq2)
    thus ?thesis by auto
  qed
next
  case (Cond b c1 c2)
  note IH1 = l. l < #:c1  c'. labels c1 l c'
  note IH2 = l. l < #:c2  c'. labels c2 l c'
  show ?case
  proof(cases "l = 0")
    case True
    thus ?thesis by(fastforce intro:Labels_Base)
  next
    case False
    hence "0 < l" by simp
    then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
    thus ?thesis
    proof(cases "l' < #:c1")
      case True
      from IH1[OF this] obtain c' where "labels c1 l' c'" by auto
      with l = l' + 1 have "labels (if (b) c1 else c2) l c'"
        by(fastforce dest:Labels_CondTrue)
      thus ?thesis by auto
    next
      case False
      hence "#:c1  l'" by simp
      then obtain l'' where "l' = l'' + #:c1" and "l'' = l' - #:c1" by simp
      from l' = l'' + #:c1 l = l' + 1 l < #:if (b) c1 else c2
      have "l'' < #:c2" by simp
      from IH2[OF this] obtain c' where "labels c2 l'' c'" by auto
      with l' = l'' + #:c1 l = l' + 1 have "labels (if (b) c1 else c2) l c'"
        by(fastforce dest:Labels_CondFalse)
      thus ?thesis by auto
    qed
  qed
next
  case (While b c')
  note IH = l. l < #:c'  c''. labels c' l c''
  show ?case
  proof(cases "l < 1")
    case True
    hence "l = 0" by simp
    thus ?thesis by(fastforce intro:Labels_Base)
  next
    case False
    show ?thesis
    proof(cases "l < 2")
      case True
      with ¬ l < 1 have "l = 1" by simp
      thus ?thesis by(fastforce intro:Labels_WhileExit)
    next
      case False
      with ¬ l < 1 have "2  l" by simp
      then obtain l' where "l = l' + 2" and "l' = l - 2" 
        by(simp del:add_2_eq_Suc')
      from l = l' + 2 l < #:while (b) c' have "l' < #:c'" by simp
      from IH[OF this] obtain c'' where "labels c' l' c''" by auto
      with l = l' + 2 have "labels (while (b) c') l (c'';;while (b) c')"
        by(fastforce dest:Labels_WhileBody)
      thus ?thesis by auto
    qed
  qed
qed



lemma labels_det:
  "labels c l c' (c''. labels c l c'' c' = c'')"
proof(induct rule: labels.induct)
  case (Labels_Base c c'') 
  from ‹labels c 0 c'' obtain l where "labels c l c''" and "l = 0" by auto
  thus ?case by(induct rule: labels.induct,auto)
next
  case (Labels_Seq1 c1 l c c2)
  note IH = c''. labels c1 l c''  c = c''
  from ‹labels c1 l c have "l < #:c1" by(fastforce intro:label_less_num_inner_nodes)
  with ‹labels (c1;;c2) l c'' obtain cx where "c'' = cx;;c2  labels c1 l cx"
    by(fastforce elim:labels.cases intro:Labels_Base)
  hence [simp]:"c'' = cx;;c2" and "labels c1 l cx" by simp_all
  from IH[OF ‹labels c1 l cx] show ?case by simp
next
  case (Labels_Seq2 c2 l c c1)
  note IH = c''. labels c2 l c''  c = c''
  from ‹labels (c1;;c2) (l + #:c1) c'' ‹labels c2 l c have "labels c2 l c''" 
    by(auto elim:labels.cases dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case .
next
  case (Labels_CondTrue c1 l c b c2)
  note IH = c''. labels c1 l c''   c = c''
  from ‹labels (if (b) c1 else c2) (l + 1) c'' ‹labels c1 l c have "labels c1 l c''"
    by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case .
next
  case (Labels_CondFalse c2 l c b c1)
  note IH = c''. labels c2 l c''   c = c''
  from ‹labels (if (b) c1 else c2) (l + #:c1 + 1) c'' ‹labels c2 l c
  have "labels c2 l c''"
    by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case .
next
  case (Labels_WhileBody c' l c b)
  note IH = c''. labels c' l c''  c = c''
  from ‹labels (while (b) c') (l + 2) c'' ‹labels c' l c 
  obtain cx where "c'' = cx;;while (b) c'  labels c' l cx" 
    by -(erule labels.cases,auto)
  hence [simp]:"c'' = cx;;while (b) c'" and "labels c' l cx" by simp_all
  from IH[OF ‹labels c' l cx] show ?case by simp
qed (fastforce elim:labels.cases)+


end

Theory WellFormed

section ‹General well-formedness of While CFG›

theory WellFormed imports 
  Interpretation 
  Labels 
  "../Basic/CFGExit_wf" 
  "../StaticIntra/CDepInstantiations" 
begin

subsection ‹Definition of some functions›

fun lhs :: "cmd  vname set"
where
  "lhs Skip                = {}"
  | "lhs (V:=e)              = {V}"
  | "lhs (c1;;c2)            = lhs c1"
  | "lhs (if (b) c1 else c2) = {}"
  | "lhs (while (b) c)       = {}"

fun rhs_aux :: "expr  vname set"
where
  "rhs_aux (Val v)       = {}"
  | "rhs_aux (Var V)       = {V}"
  | "rhs_aux (e1 «bop» e2) = (rhs_aux e1  rhs_aux e2)"

fun rhs :: "cmd  vname set"
where
  "rhs Skip                = {}"
  | "rhs (V:=e)              = rhs_aux e"
  | "rhs (c1;;c2)            = rhs c1"
  | "rhs (if (b) c1 else c2) = rhs_aux b"
  | "rhs (while (b) c)       = rhs_aux b"


lemma rhs_interpret_eq: 
  "interpret b s = Some v'; V  rhs_aux b. s V = s' V 
    interpret b s' = Some v'"
proof(induct b arbitrary:v')
  case (Val v)
  from ‹interpret (Val v) s = Some v' have "v' = v" by(fastforce elim:interpret.cases)
  thus ?case by simp
next
  case (Var V)
  hence "s' V = Some v'" by(fastforce elim:interpret.cases)
  thus ?case by simp
next
  case (BinOp b1 bop b2)
  note IH1 = v'. interpret b1 s = Some v'; V  rhs_aux b1. s V = s' V 
              interpret b1 s' = Some v'
  note IH2 = v'. interpret b2 s = Some v'; V  rhs_aux b2. s V = s' V 
              interpret b2 s' = Some v'
  from ‹interpret (b1 «bop» b2) s = Some v' 
  have "v1 v2. interpret b1 s = Some v1  interpret b2 s = Some v2 
                binop bop v1 v2 = Some v'"
    apply(cases "interpret b1 s",simp)
    apply(cases "interpret b2 s",simp)
    by(case_tac "binop bop a aa",simp+)
  then obtain v1 v2 where "interpret b1 s = Some v1"
    and "interpret b2 s = Some v2" and "binop bop v1 v2 = Some v'" by blast
  from V  rhs_aux (b1 «bop» b2). s V = s' V have "V  rhs_aux b1. s V = s' V"
    by simp
  from IH1[OF ‹interpret b1 s = Some v1 this] have "interpret b1 s' = Some v1" .
  from V  rhs_aux (b1 «bop» b2). s V = s' V have "V  rhs_aux b2. s V = s' V"
    by simp
  from IH2[OF ‹interpret b2 s = Some v2 this] have "interpret b2 s' = Some v2" .
  with ‹interpret b1 s' = Some v1 ‹binop bop v1 v2 = Some v' show ?case by simp
qed


fun Defs :: "cmd  w_node  vname set"
where "Defs prog n = {V. l c.  n = (_ l _)  labels prog l c  V  lhs c}"

fun Uses :: "cmd  w_node  vname set"
where "Uses prog n = {V. l c.  n = (_ l _)  labels prog l c  V  rhs c}"


subsection ‹Lemmas about @{term "prog  n -et n'"} to show well-formed 
  properties›

lemma WCFG_edge_no_Defs_equal:
  "prog  n -et n'; V  Defs prog n  (transfer et s) V = s V"
proof(induct rule:WCFG_induct)
  case (WCFG_LAss V' e)
  have label:"labels (V':=e) 0 (V':=e)" and lhs:"V'  lhs (V':=e)"
    by(auto intro:Labels_Base)
  hence "V'  Defs (V':=e) (_0_)" by fastforce
  with V  Defs (V':=e) (_0_) show ?case by auto
next
  case (WCFG_SeqFirst c1 n et n' c2)
  note IH = V  Defs c1 n  transfer et s V = s V
  have "V  Defs c1 n"
  proof
    assume "V  Defs c1 n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c1 l c"
      and "V  lhs c" by fastforce
    from ‹labels c1 l c have "labels (c1;;c2) l (c;;c2)"
      by(fastforce intro:Labels_Seq1)
    from V  lhs c have "V  lhs (c;;c2)" by simp
    with ‹labels (c1;;c2) l (c;;c2) have "V  Defs (c1;;c2) n" by fastforce
    with V  Defs (c1;;c2) n show False by fastforce
  qed
  from IH[OF this] show ?case .
next
  case (WCFG_SeqConnect c1 n et c2)
  note IH = V  Defs c1 n  transfer et s V = s V
  have "V  Defs c1 n"
  proof
    assume "V  Defs c1 n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c1 l c"
      and "V  lhs c" by fastforce
    from ‹labels c1 l c have "labels (c1;;c2) l (c;;c2)"
      by(fastforce intro:Labels_Seq1)
    from V  lhs c have "V  lhs (c;;c2)" by simp
    with ‹labels (c1;;c2) l (c;;c2) have "V  Defs (c1;;c2) n" by fastforce
    with V  Defs (c1;;c2) n show False by fastforce
  qed
  from IH[OF this] show ?case .
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = V  Defs c2 n  transfer et s V = s V
  have "V  Defs c2 n"
  proof
    assume "V  Defs c2 n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c2 l c"
      and "V  lhs c" by fastforce
    from ‹labels c2 l c have "labels (c1;;c2) (l + #:c1) c"
      by(fastforce intro:Labels_Seq2)
    with V  lhs c have "V  Defs (c1;;c2) (n  #:c1)" by fastforce
    with V  Defs (c1;;c2) (n  #:c1) show False by fastforce
  qed
  from IH[OF this] show ?case .
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = V  Defs c1 n  transfer et s V = s V
  have "V  Defs c1 n"
  proof
    assume "V  Defs c1 n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c1 l c"
      and "V  lhs c" by fastforce
    from ‹labels c1 l c have "labels (if (b) c1 else c2) (l + 1) c"
      by(fastforce intro:Labels_CondTrue)
    with V  lhs c have "V  Defs (if (b) c1 else c2) (n  1)" by fastforce
    with V  Defs (if (b) c1 else c2) (n  1) show False by fastforce
  qed
  from IH[OF this] show ?case .
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = V  Defs c2 n  transfer et s V = s V
  have "V  Defs c2 n"
  proof
    assume "V  Defs c2 n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c2 l c"
      and "V  lhs c" by fastforce
    from ‹labels c2 l c have "labels (if (b) c1 else c2) (l + #:c1 + 1) c"
      by(fastforce intro:Labels_CondFalse)
    with V  lhs c have "V  Defs (if (b) c1 else c2) (n  #:c1 + 1)"
      by(fastforce simp:add.commute add.left_commute)
    with V  Defs (if (b) c1 else c2) (n  #:c1 + 1) show False by fastforce
  qed
  from IH[OF this] show ?case .
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = V  Defs c' n  transfer et s V = s V
  have "V  Defs c' n"
  proof
    assume "V  Defs c' n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c' l c"
      and "V  lhs c" by fastforce
    from ‹labels c' l c have "labels (while (b) c') (l + 2) (c;;while (b) c')"
      by(fastforce intro:Labels_WhileBody)
    from V  lhs c have "V  lhs (c;;while (b) c')" by fastforce
    with ‹labels (while (b) c') (l + 2) (c;;while (b) c')
    have "V  Defs (while (b) c') (n  2)" by fastforce
    with V  Defs (while (b) c') (n  2) show False by fastforce
  qed
  from IH[OF this] show ?case .
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = V  Defs c' n  transfer et s V = s V
  have "V  Defs c' n"
  proof
    assume "V  Defs c' n"
    then obtain c l where [simp]:"n = (_ l _)" and "labels c' l c"
      and "V  lhs c" by fastforce
    from ‹labels c' l c have "labels (while (b) c') (l + 2) (c;;while (b) c')"
      by(fastforce intro:Labels_WhileBody)
    from V  lhs c have "V  lhs (c;;while (b) c')" by fastforce
    with ‹labels (while (b) c') (l + 2) (c;;while (b) c')
    have "V  Defs (while (b) c') (n  2)" by fastforce
    with V  Defs (while (b) c') (n  2) show False by fastforce
  qed
  from IH[OF this] show ?case .
qed auto


(*<*)declare One_nat_def [simp del](*>*)

lemma WCFG_edge_transfer_uses_only_Uses:
  "prog  n -et n'; V  Uses prog n. s V = s' V
   V  Defs prog n. (transfer et s) V = (transfer et s') V"
proof(induct rule:WCFG_induct)
  case (WCFG_LAss V e)
  have "Uses (V:=e) (_0_) = {V. V  rhs_aux e}"
    by(fastforce elim:labels.cases intro:Labels_Base)
  with V'Uses (V:=e) (_0_). s V' = s' V' 
  have "V'rhs_aux e. s V' = s' V'" by blast
  have "Defs (V:=e) (_0_) = {V}"
    by(fastforce elim:labels.cases intro:Labels_Base)
  have "transfer λs. s(V := interpret e s) s V =
        transfer λs. s(V := interpret e s) s' V"
  proof(cases "interpret e s")
    case None
    { fix v assume "interpret e s' = Some v"
      with V'rhs_aux e. s V' = s' V' have "interpret e s = Some v"
        by(fastforce intro:rhs_interpret_eq)
      with None have False by(fastforce split:if_split_asm) }
    with None show ?thesis by fastforce
  next
    case (Some v)
    hence "interpret e s = Some v" by(fastforce split:if_split_asm)
    with V'rhs_aux e. s V' = s' V'
    have "interpret e s' = Some v" by(fastforce intro:rhs_interpret_eq)
    with Some show ?thesis by simp
  qed
  with ‹Defs (V:=e) (_0_) = {V} show ?case by simp
next
  case (WCFG_SeqFirst c1 n et n' c2)
  note IH = VUses c1 n. s V = s' V 
     VDefs c1 n. transfer et s V = transfer et s' V
  from VUses (c1;;c2) n. s V = s' V have "VUses c1 n. s V = s' V"
    by auto(drule Labels_Seq1[of _ _ _ c2],erule_tac x="V" in allE,auto)
  from IH[OF this] have "VDefs c1 n. transfer et s V = transfer et s' V" .
  with c1  n -et n' show ?case using Labels_Base 
    apply clarsimp 
    apply(erule labels.cases,auto dest:WCFG_sourcelabel_less_num_nodes)
    by(erule_tac x="V" in allE,fastforce)
next
  case (WCFG_SeqConnect c1 n et c2)
  note IH = VUses c1 n. s V = s' V 
     VDefs c1 n. transfer et s V = transfer et s' V
  from VUses (c1;;c2) n. s V = s' V have "VUses c1 n. s V = s' V"
    by auto(drule Labels_Seq1[of _ _ _ c2],erule_tac x="V" in allE,auto)
  from IH[OF this] have "VDefs c1 n. transfer et s V = transfer et s' V" .
  with c1  n -et (_Exit_) show ?case using Labels_Base 
    apply clarsimp 
    apply(erule labels.cases,auto dest:WCFG_sourcelabel_less_num_nodes)
    by(erule_tac x="V" in allE,fastforce)
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = VUses c2 n. s V = s' V 
     VDefs c2 n. transfer et s V = transfer et s' V
  from VUses (c1;;c2) (n  #:c1). s V = s' V have "VUses c2 n. s V = s' V"
    by(auto,blast dest:Labels_Seq2)
  from IH[OF this] have "VDefs c2 n. transfer et s V = transfer et s' V" .
  with num_inner_nodes_gr_0[of "c1"] show ?case
    apply clarsimp
    apply(erule labels.cases,auto)
    by(cases n,auto dest:label_less_num_inner_nodes)+
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = VUses c1 n. s V = s' V 
     VDefs c1 n. transfer et s V = transfer et s' V
  from VUses (if (b) c1 else c2) (n  1). s V = s' V 
  have "VUses c1 n. s V = s' V" by(auto,blast dest:Labels_CondTrue)
  from IH[OF this] have "VDefs c1 n. transfer et s V = transfer et s' V" .
  with c1  n -et n' show ?case
    apply clarsimp 
    apply(erule labels.cases,auto)
    apply(cases n,auto dest:label_less_num_inner_nodes)
    by(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = VUses c2 n. s V = s' V 
     VDefs c2 n. transfer et s V = transfer et s' V
  from VUses (if (b) c1 else c2) (n  #:c1 + 1). s V = s' V 
  have "VUses c2 n. s V = s' V"
    by auto(drule Labels_CondFalse[of _ _ _ b c1],erule_tac x="V" in allE,
       auto simp:add.assoc)
  from IH[OF this] have "VDefs c2 n. transfer et s V = transfer et s' V" .
  with c2  n -et n' show ?case
    apply clarsimp 
    apply(erule labels.cases,auto)
    apply(cases n,auto dest:label_less_num_inner_nodes)
    by(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = VUses c' n. s V = s' V 
     VDefs c' n. transfer et s V = transfer et s' V
  from VUses (while (b) c') (n  2). s V = s' V have "VUses c' n. s V = s' V"
    by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
  from IH[OF this] have "VDefs c' n. transfer et s V = transfer et s' V" .
  thus ?case
    apply clarsimp 
    apply(erule labels.cases,auto)
    by(cases n,auto dest:label_less_num_inner_nodes)
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = VUses c' n. s V = s' V 
     VDefs c' n. transfer et s V = transfer et s' V
  from VUses (while (b) c') (n  2). s V = s' V have "VUses c' n. s V = s' V"
    by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
  from IH[OF this] have "VDefs c' n. transfer et s V = transfer et s' V" .
  thus ?case
    apply clarsimp 
    apply(erule labels.cases,auto)
    by(cases n,auto dest:label_less_num_inner_nodes)
qed (fastforce elim:labels.cases)+


lemma WCFG_edge_Uses_pred_eq:
  "prog  n -et n'; V  Uses prog n. s V = s' V; pred et s
     pred et s'"
proof(induct rule:WCFG_induct)
  case (WCFG_SeqFirst c1 n et n' c2)
  note IH = VUses c1 n. s V = s' V; pred et s  pred et s'
  from VUses (c1;; c2) n. s V = s' V have "VUses c1 n. s V = s' V"
    by auto(drule Labels_Seq1[of _ _ _ c2],erule_tac x="V" in allE,auto)
  from IH[OF this ‹pred et s] show ?case .
next
  case (WCFG_SeqConnect c1 n et c2)
  note IH = VUses c1 n. s V = s' V; pred et s  pred et s'
  from VUses (c1;; c2) n. s V = s' V have "VUses c1 n. s V = s' V"
    by auto(drule Labels_Seq1[of _ _ _ c2],erule_tac x="V" in allE,auto)
  from IH[OF this ‹pred et s] show ?case .
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = VUses c2 n. s V = s' V; pred et s  pred et s'
  from VUses (c1;; c2) (n  #:c1). s V = s' V
  have "VUses c2 n. s V = s' V" by(auto,blast dest:Labels_Seq2)
  from IH[OF this ‹pred et s] show ?case .
next
  case (WCFG_CondTrue b c1 c2)
  from VUses (if (b) c1 else c2) (_0_). s V = s' V 
  have all:"V. labels (if (b) c1 else c2) 0 (if (b) c1 else c2)  
            V  rhs (if (b) c1 else c2)  (s V = s' V)"
    by fastforce
  obtain v' where [simp]:"v' = true" by simp
  with ‹pred (λs. interpret b s = Some true) s
  have "interpret b s = Some v'" by simp
  have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)" by(rule Labels_Base)
  with all have "V  rhs_aux b. s V = s' V" by simp
  with ‹interpret b s = Some v' have "interpret b s' = Some v'"
    by(rule rhs_interpret_eq)
  thus ?case by simp
next
  case (WCFG_CondFalse b c1 c2)
  from VUses (if (b) c1 else c2) (_0_). s V = s' V
  have all:"V. labels (if (b) c1 else c2) 0 (if (b) c1 else c2)  
              V  rhs (if (b) c1 else c2)  (s V = s' V)"
    by fastforce
  obtain v' where [simp]:"v' = false" by simp
  with ‹pred (λs. interpret b s = Some false) s 
  have "interpret b s = Some v'" by simp
  have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)" by(rule Labels_Base)
  with all have "V  rhs_aux b. s V = s' V" by simp
  with ‹interpret b s = Some v' have "interpret b s' = Some v'"
    by(rule rhs_interpret_eq)
  thus ?case by simp
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = VUses c1 n. s V = s' V; pred et s  pred et s'
  from VUses (if (b) c1 else c2) (n  1). s V = s' V
  have "VUses c1 n. s V = s' V" by(auto,blast dest:Labels_CondTrue)
  from IH[OF this ‹pred et s] show ?case .
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = VUses c2 n. s V = s' V; pred et s  pred et s'
  from VUses (if (b) c1 else c2) (n  #:c1 + 1). s V = s' V
  have "VUses c2 n. s V = s' V"
    by auto(drule Labels_CondFalse[of _ _ _ b c1],erule_tac x="V" in allE,
       auto simp:add.assoc)
  from IH[OF this ‹pred et s] show ?case .
next
  case (WCFG_WhileTrue b c')
  from VUses (while (b) c') (_0_). s V = s' V
  have all:"V. labels (while (b) c') 0 (while (b) c')  
              V  rhs (while (b) c')  (s V = s' V)"
    by fastforce
  obtain v' where [simp]:"v' = true" by simp
  with ‹pred (λs. interpret b s = Some true) s
  have "interpret b s = Some v'" by simp
  have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
  with all have "V  rhs_aux b. s V = s' V" by simp
  with ‹interpret b s = Some v' have "interpret b s' = Some v'"
    by(rule rhs_interpret_eq)
  thus ?case by simp
next
  case (WCFG_WhileFalse b c')
  from VUses (while (b) c') (_0_). s V = s' V
  have all:"V. labels (while (b) c') 0 (while (b) c')  
              V  rhs (while (b) c')  (s V = s' V)"
    by fastforce
  obtain v' where [simp]:"v' = false" by simp
  with ‹pred (λs. interpret b s = Some false) s
  have "interpret b s = Some v'" by simp
  have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
  with all have "V  rhs_aux b. s V = s' V" by simp
  with ‹interpret b s = Some v' have "interpret b s' = Some v'"
    by(rule rhs_interpret_eq)
  thus ?case by simp
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = VUses c' n. s V = s' V; pred et s  pred et s'
  from VUses (while (b) c') (n  2). s V = s' V have "VUses c' n. s V = s' V"
    by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
  from IH[OF this ‹pred et s] show ?case .
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = VUses c' n. s V = s' V; pred et s  pred et s'
  from VUses (while (b) c') (n  2). s V = s' V have "VUses c' n. s V = s' V"
    by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
  from IH[OF this ‹pred et s] show ?case .
qed simp_all


(*<*)declare One_nat_def [simp](*>*)

interpretation While_CFG_wf: CFG_wf sourcenode targetnode kind 
  "valid_edge prog" Entry "Defs prog" "Uses prog" id
  for prog
proof(unfold_locales)
  show "Defs prog (_Entry_) = {}  Uses prog (_Entry_) = {}"
    by(simp add:Defs.simps Uses.simps)
next
  fix a V s
  assume "valid_edge prog a" and "V  Defs prog (sourcenode a)"
  obtain nx et nx' where [simp]:"a = (nx,et,nx')" by(cases a) auto
  with ‹valid_edge prog a have "prog  nx -et nx'" by(simp add:valid_edge_def)
  with V  Defs prog (sourcenode a) show "id (transfer (kind a) s) V = id s V"
    by(fastforce intro:WCFG_edge_no_Defs_equal)
next
  fix a fix s s'::state
  assume "valid_edge prog a" 
    and "VUses prog (sourcenode a). id s V = id s' V"
  obtain nx et nx' where [simp]:"a = (nx,et,nx')" by(cases a) auto
  with ‹valid_edge prog a have "prog  nx -et nx'" by(simp add:valid_edge_def)
  with VUses prog (sourcenode a). id s V = id s' V
  show "VDefs prog (sourcenode a).
             id (transfer (kind a) s) V = id (transfer (kind a) s') V"
    by -(drule WCFG_edge_transfer_uses_only_Uses,simp+)
next
  fix a s s'
  assume pred:"pred (kind a) s" and valid:"valid_edge prog a"
    and all:"VUses prog (sourcenode a). id s V = id s' V"
  obtain nx et nx' where [simp]:"a = (nx,et,nx')" by(cases a) auto
  with ‹valid_edge prog a have "prog  nx -et nx'" by(simp add:valid_edge_def)
  with ‹pred (kind a) s VUses prog (sourcenode a). id s V = id s' V
  show "pred (kind a) s'" by -(drule WCFG_edge_Uses_pred_eq,simp+)
next
  fix a a' 
  assume "valid_edge prog a" and "valid_edge prog a'" 
    and "sourcenode a = sourcenode a'" and "targetnode a  targetnode a'"
  thus "Q Q'. kind a = (Q)  kind a' = (Q')  
               (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
    by(fastforce intro!:WCFG_deterministic simp:valid_edge_def)
qed


lemma While_CFGExit_wf_aux:"CFGExit_wf sourcenode targetnode kind 
  (valid_edge prog) Entry (Defs prog) (Uses prog) id Exit"
proof(unfold_locales)
  show "Defs prog (_Exit_) = {}  Uses prog (_Exit_) = {}"
    by(simp add:Defs.simps Uses.simps)
qed

interpretation While_CFGExit_wf: CFGExit_wf sourcenode targetnode kind 
  "valid_edge prog" Entry "Defs prog" "Uses prog" id Exit
  for prog
by(rule While_CFGExit_wf_aux)


end

Theory AdditionalLemmas

section ‹Lemmas for the control dependences›

theory AdditionalLemmas imports WellFormed
begin

subsection ‹Paths to @{term "(_Exit_)"} and from @{term "(_Entry_)"} exist›

abbreviation path :: "cmd  w_node  w_edge list  w_node  bool" 
("_  _ -_→* _")
  where "prog  n -as→* n'  CFG.path sourcenode targetnode (valid_edge prog) 
    n as n'"

definition label_incrs :: "w_edge list  nat  w_edge list" ("_ ⊕s _" 60)
  where "as ⊕s i  map (λ(n,et,n'). (n  i,et,n'  i)) as"


lemma path_SeqFirst:
  "prog  n -as→* (_ l _)  prog;;c2  n -as→* (_ l _)"
proof(induct n as "(_ l _)" arbitrary:l rule:While_CFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)
  show ?case
    apply -
    apply(rule While_CFG.empty_path)
    apply(auto simp:While_CFG.valid_node_def valid_edge_def)
    by(case_tac b,auto dest:WCFG_SeqFirst WCFG_SeqConnect)
next
  case (Cons_path n'' as a n)
  note IH = prog;; c2  n'' -as→* (_ l _)
  from prog  n'' -as→* (_ l _) have "n''  (_Exit_)"
    by fastforce
  with ‹valid_edge prog a ‹sourcenode a = n ‹targetnode a = n''
  have "prog;;c2  n -kind a n''" by(simp add:valid_edge_def WCFG_SeqFirst)
  with IH prog;;c2  n -kind a n'' ‹sourcenode a = n ‹targetnode a = n'' show ?case
    by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
qed


lemma path_SeqSecond:
  "prog  n -as→* n'; n  (_Entry_); as  [] 
   c1;;prog  n  #:c1 -as ⊕s #:c1→* n'  #:c1"
proof(induct rule:While_CFG.path.induct)
  case (Cons_path n'' as n' a n)
  note IH = n''  (_Entry_); as  [] 
     c1;;prog  n''  #:c1 -as ⊕s #:c1→* n'  #:c1
  from ‹valid_edge prog a ‹sourcenode a = n ‹targetnode a = n'' n  (_Entry_)
  have "c1;;prog  n  #:c1 -kind a n''  #:c1"
    by(simp add:valid_edge_def WCFG_SeqSecond)
  from ‹sourcenode a = n ‹targetnode a = n'' ‹valid_edge prog a
  have "[(n,kind a,n'')] ⊕s #:c1 = [a] ⊕s #:c1"
    by(cases a,simp add:label_incrs_def valid_edge_def)
  show ?case
  proof(cases "as = []")
    case True
    with prog  n'' -as→* n' have [simp]:"n'' = n'" by(auto elim:While_CFG.cases)
    with c1;;prog  n  #:c1 -kind a n''  #:c1
    have "c1;;prog  n  #:c1 -[(n,kind a,n')] ⊕s #:c1→* n'  #:c1"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                  simp:label_incrs_def While_CFG.valid_node_def valid_edge_def)
    with True [(n,kind a,n'')] ⊕s #:c1 = [a] ⊕s #:c1 show ?thesis by simp
  next
    case False
    from ‹valid_edge prog a ‹targetnode a = n'' have "n''  (_Entry_)"
      by(cases n'',auto simp:valid_edge_def)
    from IH[OF this False] 
    have "c1;;prog  n''  #:c1 -as ⊕s #:c1→* n'  #:c1" .
    with c1;;prog  n  #:c1 -kind a n''  #:c1 ‹sourcenode a = n
      ‹targetnode a = n'' [(n,kind a,n'')] ⊕s #:c1 = [a] ⊕s #:c1 show ?thesis
      apply(cases a)
      apply(simp add:label_incrs_def)
      by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
  qed
qed simp


lemma path_CondTrue:
  "prog  (_ l _) -as→* n' 
   if (b) prog else c2  (_ l _)  1 -as ⊕s 1→* n'  1"
proof(induct "(_ l _)" as n' arbitrary:l rule:While_CFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _) 
    WCFG_CondTrue[of b prog c2]
  have "CFG.valid_node sourcenode targetnode (valid_edge (if (b) prog else c2)) 
    ((_ l _)  1)"
    apply(auto simp:While_CFG.valid_node_def valid_edge_def)
    apply(rotate_tac 1,drule WCFG_CondThen,simp,fastforce)
    apply(case_tac a) apply auto
     apply(rotate_tac 1,drule WCFG_CondThen,simp,fastforce)
    by(rotate_tac 1,drule WCFG_EntryD,auto)
  then show ?case
    by(fastforce intro:While_CFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as n' a)
  note IH = l. n'' = (_ l _) 
     if (b) prog else c2  (_ l _)  1 -as ⊕s 1→* n'  1
  from ‹valid_edge prog a ‹sourcenode a = (_ l _)  ‹targetnode a = n''
  have "if (b) prog else c2  (_ l _)  1 -kind a n''  1"
    by -(rule WCFG_CondThen,simp_all add:valid_edge_def)
  from ‹sourcenode a = (_ l _) ‹targetnode a = n'' ‹valid_edge prog a
  have "[((_ l _),kind a,n'')] ⊕s 1 = [a] ⊕s 1"
    by(cases a,simp add:label_incrs_def valid_edge_def)
  show ?case
  proof(cases n'')
    case (Node l')
    from IH[OF this] have "if (b) prog else c2  (_ l' _)  1 -as ⊕s 1→* n'  1" .
    with if (b) prog else c2  (_ l _)  1 -kind a n''  1 Node
    have "if (b) prog else c2  (_ l _)  1 -((_ l _)  1,kind a,n''  1)#(as ⊕s 1)→* n'  1"
      by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
    with [((_ l _),kind a,n'')] ⊕s 1 = [a] ⊕s 1 
    have "if (b) prog else c2  (_ l _)  1 -a#as ⊕s 1→* n'  1"
      by(simp add:label_incrs_def)
    thus ?thesis by simp
  next
    case Entry
    with ‹valid_edge prog a ‹targetnode a = n'' have False by fastforce
    thus ?thesis by simp
  next
    case Exit
    with prog  n'' -as→* n' have "n' = (_Exit_)" and "as = []"
      by(auto dest:While_CFGExit.path_Exit_source)
    from if (b) prog else c2  (_ l _)  1 -kind a n''  1 
    have "if (b) prog else c2  (_ l _)  1 -[((_ l _)  1,kind a,n''  1)]→* n''  1"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path 
                  simp:While_CFG.valid_node_def valid_edge_def)
    with Exit [((_ l _),kind a,n'')] ⊕s 1 = [a] ⊕s 1  n' = (_Exit_) as = []
    show ?thesis by(fastforce simp:label_incrs_def)
  qed
qed


lemma path_CondFalse:
  "prog  (_ l _) -as→* n'
   if (b) c1 else prog  (_ l _)  (#:c1 + 1) -as ⊕s (#:c1 + 1)→* n'  (#:c1 + 1)"
proof(induct "(_ l _)" as n' arbitrary:l rule:While_CFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)
    WCFG_CondFalse[of b c1 prog]
  have "CFG.valid_node sourcenode targetnode (valid_edge (if (b) c1 else prog))
    ((_ l _)  #:c1 + 1)"
    apply(auto simp:While_CFG.valid_node_def valid_edge_def)
    apply(rotate_tac 1,drule WCFG_CondElse,simp,fastforce)
    apply(case_tac a) apply auto
     apply(rotate_tac 1,drule WCFG_CondElse,simp,fastforce)
    by(rotate_tac 1,drule WCFG_EntryD,auto)
  thus ?case by(fastforce intro:While_CFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as n' a)
  note IH = l. n'' = (_ l _)  if (b) c1 else prog  (_ l _)  (#:c1 + 1) 
                                               -as ⊕s (#:c1 + 1)→* n'  (#:c1 + 1)
  from ‹valid_edge prog a ‹sourcenode a = (_ l _)  ‹targetnode a = n''
  have "if (b) c1 else prog  (_ l _)  (#:c1 + 1) -kind a n''  (#:c1 + 1)"
    by -(rule WCFG_CondElse,simp_all add:valid_edge_def)
  from ‹sourcenode a = (_ l _) ‹targetnode a = n'' ‹valid_edge prog a
  have "[((_ l _),kind a,n'')] ⊕s (#:c1 + 1) = [a] ⊕s (#:c1 + 1)"
    by(cases a,simp add:label_incrs_def valid_edge_def)
  show ?case
  proof(cases n'')
    case (Node l')
    from IH[OF this] have "if (b) c1 else prog  (_ l' _)  (#:c1 + 1) 
                                             -as ⊕s (#:c1 + 1)→* n'  (#:c1 + 1)" .
    with if (b) c1 else prog  (_ l _)  (#:c1 + 1) -kind a n''  (#:c1 + 1) Node
    have "if (b) c1 else prog  (_ l _)  (#:c1 + 1) 
      -((_ l _)  (#:c1 + 1),kind a,n''  (#:c1 + 1))#(as ⊕s (#:c1 + 1))→* 
      n'  (#:c1 + 1)"
      by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
    with [((_ l _),kind a,n'')] ⊕s (#:c1 + 1) = [a] ⊕s (#:c1 + 1) Node
    have "if (b) c1 else prog  (_ l _)  (#:c1 + 1) -a#as ⊕s (#:c1 + 1)→* 
                                n'  (#:c1 + 1)"
      by(simp add:label_incrs_def)
    thus ?thesis by simp
  next
    case Entry
    with ‹valid_edge prog a ‹targetnode a = n'' have False by fastforce
    thus ?thesis by simp
  next
    case Exit
    with prog  n'' -as→* n' have "n' = (_Exit_)" and "as = []"
      by(auto dest:While_CFGExit.path_Exit_source)
    from if (b) c1 else prog  (_ l _)  (#:c1 + 1) -kind a n''  (#:c1 + 1)
    have "if (b) c1 else prog  (_ l _)  (#:c1 + 1) 
          -[((_ l _)  (#:c1 + 1),kind a,n''  (#:c1 + 1))]→* n''  (#:c1 + 1)"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path 
                  simp:While_CFG.valid_node_def valid_edge_def)
    with Exit [((_ l _),kind a,n'')] ⊕s (#:c1 + 1) = [a] ⊕s (#:c1 + 1) n' = (_Exit_)
      as = [] 
    show ?thesis by(fastforce simp:label_incrs_def)
  qed
qed

(*<*)declare add_2_eq_Suc' [simp del] One_nat_def [simp del](*>*)

lemma path_While:
  "prog  (_ l _) -as→* (_ l' _) 
   while (b) prog  (_ l _)  2 -as ⊕s 2→* (_ l' _)  2"
proof(induct "(_ l _)" as "(_ l' _)" arbitrary:l l' rule:While_CFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)
    WCFG_WhileTrue[of b prog]
  have "CFG.valid_node sourcenode targetnode (valid_edge (while (b) prog)) ((_ l _)  2)"
    apply(auto simp:While_CFG.valid_node_def valid_edge_def)
     apply(case_tac ba) apply auto
      apply(rotate_tac 1,drule WCFG_WhileBody,auto)
     apply(rotate_tac 1,drule WCFG_WhileBodyExit,auto)
    apply(case_tac a) apply auto
     apply(rotate_tac 1,drule WCFG_WhileBody,auto)
    by(rotate_tac 1,drule WCFG_EntryD,auto)
  thus ?case by(fastforce intro:While_CFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as a)
  note IH = l. n'' = (_ l _)
     while (b) prog  (_ l _)  2 -as ⊕s 2→* (_ l' _)  2
   from ‹sourcenode a = (_ l _) ‹targetnode a = n'' ‹valid_edge prog a
  have "[((_ l _),kind a,n'')] ⊕s 2 = [a] ⊕s 2"
    by(cases a,simp add:label_incrs_def valid_edge_def)
  show ?case
  proof(cases n'')
    case (Node l'')
    with ‹valid_edge prog a ‹sourcenode a = (_ l _)  ‹targetnode a = n''
    have "while (b) prog  (_ l _)  2 -kind a n''  2"
      by -(rule WCFG_WhileBody,simp_all add:valid_edge_def)
    from IH[OF Node]
    have "while (b) prog  (_ l'' _)  2 -as ⊕s 2→* (_ l' _)  2" .
    with while (b) prog  (_ l _)  2 -kind a n''  2 Node
    have "while (b) prog  (_ l _)  2 -((_ l _)  2,kind a,n''  2)#(as ⊕s 2)→* (_ l' _)  2"
      by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
    with [((_ l _),kind a,n'')] ⊕s 2 = [a] ⊕s 2 show ?thesis by(simp add:label_incrs_def)
  next
    case Entry
    with ‹valid_edge prog a ‹targetnode a = n'' have False by fastforce
    thus ?thesis by simp
  next
    case Exit
    with prog  n'' -as→* (_ l' _) have "(_ l' _) = (_Exit_)" and "as = []"
      by(auto dest:While_CFGExit.path_Exit_source)
    then have False by simp
    thus ?thesis by simp
  qed
qed



lemma inner_node_Entry_Exit_path: 
  "l < #:prog  (as. prog  (_ l _) -as→* (_Exit_)) 
                 (as. prog  (_Entry_) -as→* (_ l _))"
proof(induct prog arbitrary:l)
  case Skip
  from l < #:Skip› have [simp]:"l = 0" by simp
  hence "Skip  (_ l _) -id (_Exit_)" by(simp add:WCFG_Skip)
  hence "Skip  (_ l _) -[((_ l _),id,(_Exit_))]→* (_Exit_)"
    by (fastforce intro: While_CFG.path.intros simp: valid_edge_def)
  have "Skip  (_Entry_) -(λs. True) (_ l _)" by(simp add:WCFG_Entry)
  hence "Skip  (_Entry_) -[((_Entry_),(λs. True),(_ l _))]→* (_ l _)"
    by(fastforce intro:While_CFG.path.intros simp:valid_edge_def While_CFG.valid_node_def)
  with ‹Skip  (_ l _) -[((_ l _),id,(_Exit_))]→* (_Exit_) show ?case by fastforce
next
  case (LAss V e)
  from l < #:V:=e have "l = 0  l = 1" by auto
  thus ?case
  proof
    assume [simp]:"l = 0"
    hence "V:=e  (_Entry_) -(λs. True) (_ l _)" by(simp add:WCFG_Entry)
    hence "V:=e  (_Entry_) -[((_Entry_),(λs. True),(_ l _))]→* (_ l _)"
      by(fastforce intro:While_CFG.path.intros simp:valid_edge_def While_CFG.valid_node_def)
    have "V:=e  (_1_) -id (_Exit_)" by(rule WCFG_LAssSkip)
    hence "V:=e  (_1_) -[((_1_),id,(_Exit_))]→* (_Exit_)"
      by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
    with WCFG_LAss have "V:=e  (_ l _) -
      [((_ l _),(λs. s(V:=(interpret e s))),(_1_)),((_1_),id,(_Exit_))]→*
      (_Exit_)"
      by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
    with V:=e  (_Entry_) -[((_Entry_),(λs. True),(_ l _))]→* (_ l _)
    show ?case by fastforce
  next
    assume [simp]:"l = 1"
    hence "V:=e  (_ l _) -id (_Exit_)" by(simp add:WCFG_LAssSkip)
    hence "V:=e  (_ l _) -[((_ l _),id,(_Exit_))]→* (_Exit_)"
      by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
    have "V:=e  (_0_) -(λs. s(V:=(interpret e s))) (_ l _)"
      by(simp add:WCFG_LAss)
    hence "V:=e  (_0_) -[((_0_),(λs. s(V:=(interpret e s))),(_ l _))]→* (_ l _)"
      by(fastforce intro:While_CFG.path.intros simp:valid_edge_def While_CFG.valid_node_def)
    with WCFG_Entry[of "V:=e"] have "V:=e  (_Entry_) -[((_Entry_),(λs. True),(_0_))
      ,((_0_),(λs. s(V:=(interpret e s))),(_ l _))]→* (_ l _)"
      by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
    with V:=e  (_ l _) -[((_ l _),id,(_Exit_))]→* (_Exit_) show ?case by fastforce
  qed
next
  case (Seq prog1 prog2)
  note IH1 = l. l < #:prog1 
  (as. prog1  (_ l _) -as→* (_Exit_))  (as. prog1  (_Entry_) -as→* (_ l _))
  note IH2 = l. l < #:prog2 
  (as. prog2  (_ l _) -as→* (_Exit_))  (as. prog2  (_Entry_) -as→* (_ l _))
  show ?case
  proof(cases "l < #:prog1")
    case True
    from IH1[OF True] obtain as as' where "prog1  (_ l _) -as→* (_Exit_)"
      and "prog1  (_Entry_) -as'→* (_ l _)" by blast
    from prog1  (_Entry_) -as'→* (_ l _)
    have "prog1;;prog2  (_Entry_) -as'→* (_ l _)"
      by(fastforce intro:path_SeqFirst)
    from prog1  (_ l _) -as→* (_Exit_)
    obtain asx ax where "prog1  (_ l _) -asx@[ax]→* (_Exit_)"
      by(induct rule:rev_induct,auto elim:While_CFG.path.cases)
    hence "prog1  (_ l _) -asx→* sourcenode ax"
      and "valid_edge prog1 ax" and "(_Exit_) = targetnode ax"
      by(auto intro:While_CFG.path_split_snoc)
    from prog1  (_ l _) -asx→* sourcenode ax ‹valid_edge prog1 ax
    obtain lx where [simp]:"sourcenode ax = (_ lx _)"
      by(cases "sourcenode ax") auto
    with prog1  (_ l _) -asx→* sourcenode ax 
    have "prog1;;prog2  (_ l _) -asx→* sourcenode ax"
      by(fastforce intro:path_SeqFirst)
    from ‹valid_edge prog1 ax (_Exit_) = targetnode ax
    have "prog1;;prog2  sourcenode ax -kind ax (_0_)  #:prog1"
      by(fastforce intro:WCFG_SeqConnect simp:valid_edge_def)
    hence "prog1;;prog2  sourcenode ax -[(sourcenode ax,kind ax,(_0_)  #:prog1)]→*
                          (_0_)  #:prog1"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path 
                  simp:While_CFG.valid_node_def valid_edge_def)
    with prog1;;prog2  (_ l _) -asx→* sourcenode ax
    have "prog1;;prog2  (_ l _) -asx@[(sourcenode ax,kind ax,(_0_)  #:prog1)]→*
                         (_0_)  #:prog1"
      by(fastforce intro:While_CFG.path_Append)
    from IH2[of "0"] obtain as'' where "prog2  (_ 0 _) -as''→* (_Exit_)" by blast
    hence "prog1;;prog2  (_0_)  #:prog1 -as'' ⊕s #:prog1→* (_Exit_)  #:prog1"
      by(fastforce intro!:path_SeqSecond elim:While_CFG.path.cases)
    hence "prog1;;prog2  (_0_)  #:prog1 -as'' ⊕s #:prog1→* (_Exit_)"
      by simp
    with prog1;;prog2  (_ l _) -asx@[(sourcenode ax,kind ax,(_0_)  #:prog1)]→*
                         (_0_)  #:prog1
    have "prog1;;prog2  (_ l _) -(asx@[(sourcenode ax,kind ax,(_0_)  #:prog1)])@
                                  (as'' ⊕s #:prog1)→* (_Exit_)"
      by(fastforce intro:While_CFG.path_Append)
    with prog1;;prog2  (_Entry_) -as'→* (_ l _) show ?thesis by blast
  next
    case False
    hence "#:prog1  l" by simp
    then obtain l' where [simp]:"l = l' + #:prog1" and "l' = l - #:prog1" by simp
    from l < #:prog1;; prog2 have "l' < #:prog2" by simp
    from IH2[OF this] obtain as as' where "prog2  (_ l' _) -as→* (_Exit_)"
      and "prog2  (_Entry_) -as'→* (_ l' _)" by blast
    from prog2  (_ l' _) -as→* (_Exit_) 
    have "prog1;;prog2  (_ l' _)  #:prog1 -as ⊕s #:prog1→* (_Exit_)  #:prog1"
      by(fastforce intro!:path_SeqSecond elim:While_CFG.path.cases)
    hence "prog1;;prog2  (_ l _) -as ⊕s #:prog1→* (_Exit_)"
      by simp
    from IH1[of 0] obtain as'' where "prog1  (_0_) -as''→* (_Exit_)" by blast
    then obtain ax asx where "prog1  (_0_) -asx@[ax]→* (_Exit_)"
      by(induct rule:rev_induct,auto elim:While_CFG.path.cases)
    hence "prog1  (_0_) -asx→* sourcenode ax" and "valid_edge prog1 ax"
      and "(_Exit_) = targetnode ax" by(auto intro:While_CFG.path_split_snoc)
    from WCFG_Entry prog1  (_0_) -asx→* sourcenode ax
    have "prog1  (_Entry_) -((_Entry_),(λs. True),(_0_))#asx→* sourcenode ax"
      by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
    from prog1  (_0_) -asx→* sourcenode ax ‹valid_edge prog1 ax
    obtain lx where [simp]:"sourcenode ax = (_ lx _)"
      by(cases "sourcenode ax") auto
    with prog1  (_Entry_) -((_Entry_),(λs. True),(_0_))#asx→* sourcenode ax
    have "prog1;;prog2  (_Entry_) -((_Entry_),(λs. True),(_0_))#asx→* 
                         sourcenode ax"
      by(fastforce intro:path_SeqFirst)
    from prog2  (_Entry_) -as'→* (_ l' _) obtain ax' asx' 
      where "prog2  (_Entry_) -ax'#asx'→* (_ l' _)" 
      by(cases as',auto elim:While_CFG.path.cases)
    hence "(_Entry_) = sourcenode ax'" and "valid_edge prog2 ax'"
      and "prog2  targetnode ax' -asx'→* (_ l' _)"
      by(auto intro:While_CFG.path_split_Cons)
    hence "targetnode ax' = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
    from ‹valid_edge prog1 ax (_Exit_) = targetnode ax
    have "prog1;;prog2  sourcenode ax -kind ax (_0_)  #:prog1"
      by(fastforce intro:WCFG_SeqConnect simp:valid_edge_def)
    have "as. prog1;;prog2  sourcenode ax -as→* (_ l _)"
    proof(cases "asx' = []")
      case True
      with prog2  targetnode ax' -asx'→* (_ l' _) ‹targetnode ax' = (_0_)
      have "l' = 0" by(auto elim:While_CFG.path.cases)
      with prog1;;prog2  sourcenode ax -kind ax (_0_)  #:prog1     
      have "prog1;;prog2  sourcenode ax -[(sourcenode ax,kind ax,(_ l _))]→* 
                           (_ l _)"
        by(auto intro!:While_CFG.path.intros 
                    simp:While_CFG.valid_node_def valid_edge_def,blast)
      thus ?thesis by blast
    next
      case False
      with prog2  targetnode ax' -asx'→* (_ l' _) ‹targetnode ax' = (_0_)
      have "prog1;;prog2  (_0_)  #:prog1 -asx' ⊕s #:prog1→* (_ l' _)  #:prog1"
        by(fastforce intro:path_SeqSecond)
      hence "prog1;;prog2  (_0_)  #:prog1 -asx' ⊕s #:prog1→* (_ l _)" by simp
      with prog1;;prog2  sourcenode ax -kind ax (_0_)  #:prog1
      have "prog1;;prog2  sourcenode ax -(sourcenode ax,kind ax,(_0_)  #:prog1)#
                                          (asx' ⊕s #:prog1)→* (_ l _)"
        by(fastforce intro: While_CFG.Cons_path simp:valid_node_def valid_edge_def)
      thus ?thesis by blast
    qed
    then obtain asx'' where "prog1;;prog2  sourcenode ax -asx''→* (_ l _)" by blast
    with prog1;;prog2  (_Entry_) -((_Entry_),(λs. True),(_0_))#asx→* 
                         sourcenode ax
    have "prog1;;prog2  (_Entry_) -(((_Entry_),(λs. True),(_0_))#asx)@asx''→* 
                         (_ l _)"
      by(rule While_CFG.path_Append)
    with prog1;;prog2  (_ l _) -as ⊕s #:prog1→* (_Exit_)
    show ?thesis by blast
  qed
next
  case (Cond b prog1 prog2)
  note IH1 = l. l < #:prog1 
  (as. prog1  (_ l _) -as→* (_Exit_))  (as. prog1  (_Entry_) -as→* (_ l _))
  note IH2 = l. l < #:prog2 
  (as. prog2  (_ l _) -as→* (_Exit_))  (as. prog2  (_Entry_) -as→* (_ l _))
  show ?case
  proof(cases "l = 0")
    case True
    from IH1[of 0] obtain as where "prog1  (_0_) -as→* (_Exit_)" by blast
    hence "if (b) prog1 else prog2  (_0_)  1 -as ⊕s 1→* (_Exit_)  1"
      by(fastforce intro:path_CondTrue)
    with WCFG_CondTrue[of b prog1 prog2] have "if (b) prog1 else prog2  
      (_0_) -((_0_),(λs. interpret b s = Some true),(_0_)  1)#(as ⊕s 1)→* 
      (_Exit_)  1"
      by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
    with True have "if (b) prog1 else prog2  
      (_ l _) -((_0_),(λs. interpret b s = Some true),(_0_)  1)#(as ⊕s 1)→*
      (_Exit_)" by simp
    moreover
    from WCFG_Entry[of "if (b) prog1 else prog2"] True
    have "if (b) prog1 else prog2  (_Entry_) -[((_Entry_),(λs. True),(_0_))]→* 
                                    (_ l _)"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                  simp:While_CFG.valid_node_def valid_edge_def)
    ultimately show ?thesis by blast
  next
    case False
    hence "0 < l" by simp
    then obtain l' where [simp]:"l = l' + 1" and "l' = l - 1" by simp
    show ?thesis
    proof(cases "l' < #:prog1")
      case True
      from IH1[OF this] obtain as as' where "prog1  (_ l' _) -as→* (_Exit_)"
        and "prog1  (_Entry_) -as'→* (_ l' _)" by blast
      from prog1  (_ l' _) -as→* (_Exit_)
      have "if (b) prog1 else prog2  (_ l' _)  1 -as ⊕s 1→* (_Exit_)  1"
        by(fastforce intro:path_CondTrue)
      hence "if (b) prog1 else prog2  (_ l _) -as ⊕s 1→* (_Exit_)"
        by simp
      from prog1  (_Entry_) -as'→* (_ l' _) obtain ax asx
        where "prog1  (_Entry_) -ax#asx→* (_ l' _)"
        by(cases as',auto elim:While_CFG.cases)
      hence "(_Entry_) = sourcenode ax" and "valid_edge prog1 ax"
        and "prog1  targetnode ax -asx→* (_ l' _)"
        by(auto intro:While_CFG.path_split_Cons)
      hence "targetnode ax = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
      with prog1  targetnode ax -asx→* (_ l' _)
      have "if (b) prog1 else prog2  (_0_)  1 -asx ⊕s 1→* (_ l' _)  1"
        by(fastforce intro:path_CondTrue)
      with WCFG_CondTrue[of b prog1 prog2]
      have "if (b) prog1 else prog2  (_0_) 
        -((_0_),(λs. interpret b s = Some true),(_0_)  1)#(asx ⊕s 1)→* 
         (_ l' _)  1"
        by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
      with WCFG_Entry[of "if (b) prog1 else prog2"]
      have "if (b) prog1 else prog2  (_Entry_) -((_Entry_),(λs. True),(_0_))#
        ((_0_),(λs. interpret b s = Some true),(_0_)  1)#(asx ⊕s 1)→* 
         (_ l' _)  1"
        by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
      with if (b) prog1 else prog2  (_ l _) -as ⊕s 1→* (_Exit_)
      show ?thesis by simp blast
    next
      case False
      hence "#:prog1  l'" by simp
      then obtain l'' where [simp]:"l' = l'' + #:prog1" and "l'' = l' - #:prog1"
        by simp
      from  l < #:(if (b) prog1 else prog2) 
      have "l'' < #:prog2" by simp
      from IH2[OF this] obtain as as' where "prog2  (_ l'' _) -as→* (_Exit_)"
        and "prog2  (_Entry_) -as'→* (_ l'' _)" by blast
      from prog2  (_ l'' _) -as→* (_Exit_)
      have "if (b) prog1 else prog2  (_ l'' _)  (#:prog1 + 1) 
        -as ⊕s (#:prog1 + 1)→* (_Exit_)  (#:prog1 + 1)"
        by(fastforce intro:path_CondFalse)
      hence "if (b) prog1 else prog2  (_ l _) -as ⊕s (#:prog1 + 1)→* (_Exit_)"
        by(simp add:add.assoc)
      from prog2  (_Entry_) -as'→* (_ l'' _) obtain ax asx
        where "prog2  (_Entry_) -ax#asx→* (_ l'' _)"
        by(cases as',auto elim:While_CFG.cases)
      hence "(_Entry_) = sourcenode ax" and "valid_edge prog2 ax"
        and "prog2  targetnode ax -asx→* (_ l'' _)"
        by(auto intro:While_CFG.path_split_Cons)
      hence "targetnode ax = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
      with prog2  targetnode ax -asx→* (_ l'' _)
      have "if (b) prog1 else prog2  (_0_)  (#:prog1 + 1) -asx ⊕s (#:prog1 + 1)→*
        (_ l'' _)  (#:prog1 + 1)"
        by(fastforce intro:path_CondFalse)
      with WCFG_CondFalse[of b prog1 prog2]
      have "if (b) prog1 else prog2  (_0_) 
        -((_0_),(λs. interpret b s = Some false),(_0_)  (#:prog1 + 1))#
        (asx ⊕s  (#:prog1 + 1))→* (_ l'' _)   (#:prog1 + 1)"
        by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
      with WCFG_Entry[of "if (b) prog1 else prog2"]
      have "if (b) prog1 else prog2  (_Entry_) -((_Entry_),(λs. True),(_0_))#
        ((_0_),(λs. interpret b s = Some false),(_0_)  (#:prog1 + 1))#
        (asx ⊕s (#:prog1 + 1))→* (_ l'' _)  (#:prog1 + 1)"
        by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
      with 
        if (b) prog1 else prog2  (_ l _) -as ⊕s (#:prog1 + 1)→* (_Exit_)
      show ?thesis by(simp add:add.assoc,blast)
    qed
  qed
next
  case (While b prog')
  note IH = l. l < #:prog' 
   (as. prog'  (_ l _) -as→* (_Exit_))  (as. prog'  (_Entry_) -as→* (_ l _))
  show ?case
  proof(cases "l < 1")
    case True
    from WCFG_Entry[of "while (b) prog'"]
    have "while (b) prog'  (_Entry_) -[((_Entry_),(λs. True),(_0_))]→* (_0_)"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                  simp:While_CFG.valid_node_def valid_edge_def)
    from WCFG_WhileFalseSkip[of b prog']
    have "while (b) prog'  (_1_) -[((_1_),id,(_Exit_))]→* (_Exit_)"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                  simp:valid_node_def valid_edge_def)
    with WCFG_WhileFalse[of b prog']
    have "while (b) prog'  (_0_) -((_0_),(λs. interpret b s = Some false),(_1_))#
      [((_1_),id,(_Exit_))]→* (_Exit_)"
      by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                  simp:valid_node_def valid_edge_def)
    with while (b) prog'  (_Entry_) -[((_Entry_),(λs. True),(_0_))]→* (_0_) True
    show ?thesis by simp blast
  next
    case False
    hence "1  l" by simp
    thus ?thesis
    proof(cases "l < 2")
      case True
      with 1  l have [simp]:"l = 1" by simp
      from WCFG_WhileFalseSkip[of b prog']
      have "while (b) prog'  (_1_) -[((_1_),id,(_Exit_))]→* (_Exit_)"
        by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                    simp:valid_node_def valid_edge_def)
      from WCFG_WhileFalse[of b prog']
      have "while (b) prog'  (_0_) 
        -[((_0_),(λs. interpret b s = Some false),(_1_))]→* (_1_)"
        by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                    simp:While_CFG.valid_node_def valid_edge_def)
      with WCFG_Entry[of "while (b) prog'"]
      have "while (b) prog'  (_Entry_) -((_Entry_),(λs. True),(_0_))#
        [((_0_),(λs. interpret b s = Some false),(_1_))]→* (_1_)"
        by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
      with while (b) prog'  (_1_) -[((_1_),id,(_Exit_))]→* (_Exit_) 
      show ?thesis by simp blast
    next
      case False
      with 1  l have "2  l" by simp
      then obtain l' where [simp]:"l = l' + 2" and "l' = l - 2" 
        by(simp del:add_2_eq_Suc')
      from l < #:while (b) prog' have "l' < #:prog'" by simp
      from IH[OF this] obtain as as' where "prog'  (_ l' _) -as→* (_Exit_)"
        and "prog'  (_Entry_) -as'→* (_ l' _)" by blast
      from prog'  (_ l' _) -as→* (_Exit_) obtain ax asx where
        "prog'  (_ l' _) -asx@[ax]→* (_Exit_)"
        by(induct as rule:rev_induct,auto elim:While_CFG.cases)
      hence "prog'  (_ l' _) -asx→* sourcenode ax" and "valid_edge prog' ax"
        and "(_Exit_) = targetnode ax"
        by(auto intro:While_CFG.path_split_snoc)
      then obtain lx where "sourcenode ax = (_ lx _)"
        by(cases "sourcenode ax") auto
      with prog'  (_ l' _) -asx→* sourcenode ax
      have "while (b) prog'  (_ l' _)  2 -asx ⊕s 2→* sourcenode ax  2"
        by(fastforce intro:path_While simp del:label_incr.simps)
      from WCFG_WhileFalseSkip[of b prog']
      have "while (b) prog'  (_1_) -[((_1_),id,(_Exit_))]→* (_Exit_)"
        by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                    simp:valid_node_def valid_edge_def)
      with WCFG_WhileFalse[of b prog']
      have "while (b) prog'  (_0_) -((_0_),(λs. interpret b s = Some false),(_1_))#
        [((_1_),id,(_Exit_))]→* (_Exit_)"
        by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
      with ‹valid_edge prog' ax (_Exit_) = targetnode ax ‹sourcenode ax = (_ lx _)
      have "while (b) prog'  sourcenode ax  2 -(sourcenode ax  2,kind ax,(_0_))#
        ((_0_),(λs. interpret b s = Some false),(_1_))#
        [((_1_),id,(_Exit_))]→* (_Exit_)"
        by(fastforce intro:While_CFG.Cons_path dest:WCFG_WhileBodyExit
                    simp:valid_node_def valid_edge_def)
      with while (b) prog'  (_ l' _)  2 -asx ⊕s 2→* sourcenode ax  2
      have path:"while (b) prog'  (_ l' _)  2 -(asx ⊕s 2)@
        ((sourcenode ax  2,kind ax,(_0_))#
        ((_0_),(λs. interpret b s = Some false),(_1_))#
        [((_1_),id,(_Exit_))])→* (_Exit_)"
        by(rule While_CFG.path_Append)
      from prog'  (_Entry_) -as'→* (_ l' _) obtain ax' asx'
        where "prog'  (_Entry_) -ax'#asx'→* (_ l' _)"
        by(cases as',auto elim:While_CFG.cases)
      hence "(_Entry_) = sourcenode ax'" and "valid_edge prog' ax'"
        and "prog'  targetnode ax' -asx'→* (_ l' _)"
        by(auto intro:While_CFG.path_split_Cons)
      hence "targetnode ax' = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
      with prog'  targetnode ax' -asx'→* (_ l' _)
      have "while (b) prog'  (_0_)  2 -asx' ⊕s 2→* (_ l' _)  2"
        by(fastforce intro:path_While)
      with WCFG_WhileTrue[of b prog']
      have "while (b) prog'  (_0_) 
        -((_0_),(λs. interpret b s = Some true),(_0_)  2)#(asx' ⊕s 2)→* 
        (_ l' _)  2"
        by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
      with WCFG_Entry[of "while (b) prog'"]
      have "while (b) prog'  (_Entry_) -((_Entry_),(λs. True),(_0_))#
        ((_0_),(λs. interpret b s = Some true),(_0_)  2)#(asx' ⊕s 2)→* 
        (_ l' _)  2"
        by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
      with path show ?thesis by simp blast
    qed
  qed
qed

(*<*)declare add_2_eq_Suc' [simp] One_nat_def [simp](*>*)


lemma valid_node_Exit_path:
  assumes "valid_node prog n" shows "as. prog  n -as→* (_Exit_)"
proof(cases n)
  case (Node l)
  with ‹valid_node prog n have "l < #:prog"
    by(fastforce dest:WCFG_sourcelabel_less_num_nodes WCFG_targetlabel_less_num_nodes
                simp:valid_node_def valid_edge_def)
  with Node show ?thesis by(fastforce dest:inner_node_Entry_Exit_path)
next
  case Entry
  from WCFG_Entry_Exit[of prog]
  have "prog  (_Entry_) -[((_Entry_),(λs. False),(_Exit_))]→* (_Exit_)"
    by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                simp:valid_node_def valid_edge_def)
  with Entry show ?thesis by blast
next
  case Exit
  with WCFG_Entry_Exit[of prog]
  have "prog  n -[]→* (_Exit_)"
    by(fastforce intro:While_CFG.empty_path simp:valid_node_def valid_edge_def)
  thus ?thesis by blast
qed


lemma valid_node_Entry_path:
  assumes "valid_node prog n" shows "as. prog  (_Entry_) -as→* n"
proof(cases n)
  case (Node l)
  with ‹valid_node prog n have "l < #:prog"
    by(fastforce dest:WCFG_sourcelabel_less_num_nodes WCFG_targetlabel_less_num_nodes
                simp:valid_node_def valid_edge_def)
  with Node show ?thesis by(fastforce dest:inner_node_Entry_Exit_path)
next
  case Entry
  with WCFG_Entry_Exit[of prog]
  have "prog  (_Entry_) -[]→* n"
    by(fastforce intro:While_CFG.empty_path simp:valid_node_def valid_edge_def)
  thus ?thesis by blast
next
  case Exit
  from WCFG_Entry_Exit[of prog]
  have "prog  (_Entry_) -[((_Entry_),(λs. False),(_Exit_))]→* (_Exit_)"
    by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
                simp:valid_node_def valid_edge_def)
  with Exit show ?thesis by blast
qed


subsection ‹Some finiteness considerations›

lemma finite_labels:"finite {l. c. labels prog l c}"
proof -
  have "finite {l::nat. l < #:prog}" by(fastforce intro:nat_seg_image_imp_finite)
  moreover have "{l. c. labels prog l c}  {l::nat. l < #:prog}"
    by(fastforce intro:label_less_num_inner_nodes)
  ultimately show ?thesis by(auto intro:finite_subset)
qed


lemma finite_valid_nodes:"finite {n. valid_node prog n}"
proof -
  have "{n. n' et. prog  n -et n'}  
    insert (_Entry_) ((λl'. (_ l' _)) ` {l. c. labels prog l c})"
    apply clarsimp
    apply(case_tac x,auto)
    by(fastforce dest:WCFG_sourcelabel_less_num_nodes less_num_inner_nodes_label)
  hence "finite {n. n' et. prog  n -et n'}"
    by(auto intro:finite_subset finite_imageI finite_labels)
  have "{n'. n et. prog  n -et n'}  
    insert (_Exit_) ((λl'. (_ l' _)) ` {l. c. labels prog l c})"
    apply clarsimp
    apply(case_tac x,auto)
    by(fastforce dest:WCFG_targetlabel_less_num_nodes less_num_inner_nodes_label)
  hence "finite {n'. n et. prog  n -et n'}"
    by(auto intro:finite_subset finite_imageI finite_labels)
  have "{n. nx et nx'. prog  nx -et nx'  (n = nx  n = nx')} =
    {n. n' et. prog  n -et n'} Un {n'. n et. prog  n -et n'}" by blast
  with ‹finite {n. n' et. prog  n -et n'} ‹finite {n'. n et. prog  n -et n'}
  have "finite {n. nx et nx'. prog  nx -et nx'  (n = nx  n = nx')}"
    by fastforce
  thus ?thesis by(simp add:valid_node_def valid_edge_def)
qed

lemma finite_successors:
  "finite {n'. a'. valid_edge prog a'  sourcenode a' = n  
                    targetnode a' = n'}"
proof -
  have "{n'. a'. valid_edge prog a'  sourcenode a' = n  
                  targetnode a' = n'}  {n. valid_node prog n}"
    by(auto simp:valid_edge_def valid_node_def)
  thus ?thesis by(fastforce elim:finite_subset intro:finite_valid_nodes)
qed


end

Theory DynamicControlDependences

section ‹Interpretations of the various dynamic control dependences›

theory DynamicControlDependences imports AdditionalLemmas "../Dynamic/DynPDG" begin

interpretation WDynStandardControlDependence:
  DynStandardControlDependencePDG sourcenode targetnode kind "valid_edge prog"
                    Entry "Defs prog" "Uses prog" id Exit
  for prog
proof(unfold_locales)
  fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
  hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
  thus "as. prog  (_Entry_) -as→* n" by(rule valid_node_Entry_path)
next
  fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
  hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
  thus "as. prog  n -as→* (_Exit_)" by(rule valid_node_Exit_path)
qed

interpretation WDynWeakControlDependence:
  DynWeakControlDependencePDG sourcenode targetnode kind "valid_edge prog"
                    Entry "Defs prog" "Uses prog" id Exit
  for prog
proof(unfold_locales)
  fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
  hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
  show "finite {n'. a'. valid_edge prog a'  sourcenode a' = n 
                         targetnode a' = n'}"
    by(rule finite_successors)
qed

end

Theory Semantics

section ‹Semantics›

theory Semantics imports Labels Com begin

subsection ‹Small Step Semantics›


inductive red :: "cmd * state  cmd * state  bool"
and red' :: "cmd  state  cmd  state  bool"
  ("((1_,/_) / (1_,/_))" [0,0,0,0] 81)
where
   "c,s  c',s' == red (c,s) (c',s')"
  | RedLAss:
   "V:=e,s  Skip,s(V:=(interpret e s))"

  | SeqRed:
  "c1,s  c1',s'  c1;;c2,s  c1';;c2,s'"

  | RedSeq:
  "Skip;;c2,s  c2,s"

  | RedCondTrue:
  "interpret b s = Some true  if (b) c1 else c2,s  c1,s"

  | RedCondFalse:
  "interpret b s = Some false  if (b) c1 else c2,s  c2,s"

  | RedWhileTrue:
  "interpret b s = Some true  while (b) c,s  c;;while (b) c,s"

  | RedWhileFalse:
  "interpret b s = Some false  while (b) c,s  Skip,s"

lemmas red_induct = red.induct[split_format (complete)]

abbreviation reds ::"cmd  state  cmd  state  bool" 
   ("((1_,/_) →*/ (1_,/_))" [0,0,0,0] 81) where
  "c,s →* c',s' == red** (c,s) (c',s')"


subsection‹Label Semantics›

inductive step :: "cmd  cmd  state  nat  cmd  state  nat  bool"
   ("(_  (1_,/_,/_) / (1_,/_,/_))" [51,0,0,0,0,0,0] 81)
where

StepLAss:
  "V:=e  V:=e,s,0  Skip,s(V:=(interpret e s)),1"

| StepSeq:
  "labels (c1;;c2) l (Skip;;c2); labels (c1;;c2) #:c1 c2; l < #:c1 
   c1;;c2  Skip;;c2,s,l  c2,s,#:c1"

| StepSeqWhile:
  "labels (while (b) c') l (Skip;;while (b) c')
   while (b) c'  Skip;;while (b) c',s,l  while (b) c',s,0"

| StepCondTrue:
  "interpret b s = Some true 
      if (b) c1 else c2  if (b) c1 else c2,s,0  c1,s,1"

| StepCondFalse:
  "interpret b s = Some false 
   if (b) c1 else c2  if (b) c1 else c2,s,0  c2,s,#:c1 + 1"

| StepWhileTrue:
  "interpret b s = Some true 
      while (b) c  while (b) c,s,0  c;;while (b) c,s,2"

| StepWhileFalse:
  "interpret b s = Some false  while (b) c  while (b) c,s,0  Skip,s,1"

| StepRecSeq1:
  "prog  c,s,l  c',s',l'
   prog;;c2  c;;c2,s,l  c';;c2,s',l'"

| StepRecSeq2:
  "prog  c,s,l  c',s',l' 
   c1;;prog  c,s,l + #:c1  c',s',l' + #:c1"

| StepRecCond1:
  "prog  c,s,l  c',s',l' 
   if (b) prog else c2  c,s,l + 1  c',s',l' + 1"

| StepRecCond2:
  "prog  c,s,l  c',s',l' 
   if (b) c1 else prog  c,s,l + #:c1 + 1  c',s',l' + #:c1 + 1"

| StepRecWhile:
  "cx  c,s,l  c',s',l'
   while (b) cx  c;;while (b) cx,s,l + 2  c';;while (b) cx,s',l' + 2"


lemma step_label_less:
  "prog  c,s,l  c',s',l'  l < #:prog  l' < #:prog"
proof(induct rule:step.induct)
  case (StepSeq c1 c2 l s)
  from ‹labels (c1;;c2) l (Skip;;c2)
  have "l < #:(c1;; c2)" by(rule label_less_num_inner_nodes)
  thus ?case by(simp add:num_inner_nodes_gr_0)
next
  case (StepSeqWhile b cx l s)
  from ‹labels (while (b) cx) l (Skip;;while (b) cx)
  have "l < #:(while (b) cx)" by(rule label_less_num_inner_nodes)
  thus ?case by simp
qed (auto intro:num_inner_nodes_gr_0)



abbreviation steps :: "cmd  cmd  state  nat  cmd  state  nat  bool"
   ("(_  (1_,/_,/_) ↝*/ (1_,/_,/_))" [51,0,0,0,0,0,0] 81) where 
  "prog  c,s,l ↝* c',s',l' == 
     (λ(c,s,l) (c',s',l'). prog  c,s,l  c',s',l')** (c,s,l) (c',s',l')"


subsection‹Proof of bisimulation of @{term "c,s  c',s'"}\\
  and @{term "prog  c,s,l ↝* c',s',l'"} via @{term "labels"}

(*<*)
lemmas converse_rtranclp_induct3 =
  converse_rtranclp_induct[of _ "(ax,ay,az)" "(bx,by,bz)", split_rule,
                 consumes 1, case_names refl step]
(*>*)


subsubsection ‹From @{term "prog  c,s,l ↝* c',s',l'"} to
  @{term "c,s  c',s'"}

lemma step_red:
  "prog  c,s,l  c',s',l'  c,s  c',s'"
by(induct rule:step.induct,rule RedLAss,auto intro:red.intros)



lemma steps_reds:
  "prog  c,s,l ↝* c',s',l'  c,s →* c',s'"
proof(induct rule:converse_rtranclp_induct3)
  case refl thus ?case by simp
next
  case (step c s l c'' s'' l'')
  then have "prog  c,s,l  c'',s'',l''"
    and "c'',s'' →* c',s'" by simp_all
  from prog  c,s,l  c'',s'',l'' have "c,s  c'',s''"
    by(fastforce intro:step_red)
  with c'',s'' →* c',s' show ?case
    by(fastforce intro:converse_rtranclp_into_rtranclp)
qed


(*<*)declare fun_upd_apply [simp del] One_nat_def [simp del](*>*)

subsubsection ‹From @{term "c,s  c',s'"} and @{term labels} to
  @{term "prog  c,s,l ↝* c',s',l'"}

lemma red_step:
  "labels prog l c; c,s  c',s'
   l'. prog  c,s,l  c',s',l'  labels prog l' c'"
proof(induct arbitrary:c' rule:labels.induct)
  case (Labels_Base c)
  from c,s  c',s' show ?case
  proof(induct rule:red_induct)
    case (RedLAss V e s)
    have "V:=e  V:=e,s,0  Skip,s(V:=(interpret e s)),1" by(rule StepLAss)
    have "labels (V:=e) 1 Skip" by(fastforce intro:Labels_LAss)
    with V:=e  V:=e,s,0  Skip,s(V:=(interpret e s)),1 show ?case by blast
  next
    case (SeqRed c1 s c1' s' c2)
    from l'. c1  c1,s,0  c1',s',l'  labels c1 l' c1'
    obtain l' where "c1  c1,s,0  c1',s',l'" and "labels c1 l' c1'" by blast
    from c1  c1,s,0  c1',s',l' have "c1;;c2  c1;;c2,s,0  c1';;c2,s',l'"
      by(rule StepRecSeq1)
    moreover
    from ‹labels c1 l' c1' have "labels (c1;;c2) l' (c1';;c2)" by(rule Labels_Seq1)
    ultimately show ?case by blast
  next
    case (RedSeq c2 s)
    have "labels c2 0 c2" by(rule Labels.Labels_Base)
    hence "labels (Skip;;c2) (0 + #:Skip) c2" by(rule Labels_Seq2)
    have "labels (Skip;;c2) 0 (Skip;;c2)" by(rule Labels.Labels_Base)
    with ‹labels (Skip;;c2) (0 + #:Skip) c2
    have "Skip;;c2  Skip;;c2,s,0  c2,s,#:Skip"
      by(fastforce intro:StepSeq)
    with ‹labels (Skip;;c2) (0 + #:Skip) c2 show ?case by auto
  next
    case (RedCondTrue b s c1 c2)
    from ‹interpret b s = Some true›
    have "if (b) c1 else c2  if (b) c1 else c2,s,0  c1,s,1"
      by(rule StepCondTrue)
    have "labels (if (b) c1 else c2) (0 + 1) c1"
      by(rule Labels_CondTrue,rule Labels.Labels_Base)
    with if (b) c1 else c2  if (b) c1 else c2,s,0  c1,s,1 show ?case by auto
  next
    case (RedCondFalse b s c1 c2)
    from ‹interpret b s = Some false› 
    have "if (b) c1 else c2  if (b) c1 else c2,s,0  c2,s,#:c1 + 1"
      by(rule StepCondFalse)
    have "labels (if (b) c1 else c2) (0 + #:c1 + 1) c2"
      by(rule Labels_CondFalse,rule Labels.Labels_Base)
    with if (b) c1 else c2  if (b) c1 else c2,s,0  c2,s,#:c1 + 1
    show ?case by auto
  next
    case (RedWhileTrue b s c)
    from ‹interpret b s = Some true›
    have "while (b) c  while (b) c,s,0  c;; while (b) c,s,2"
      by(rule StepWhileTrue)
    have "labels (while (b) c) (0 + 2) (c;; while (b) c)"
      by(rule Labels_WhileBody,rule Labels.Labels_Base)
    with while (b) c  while (b) c,s,0  c;; while (b) c,s,2
    show ?case by(auto simp del:add_2_eq_Suc')
  next
    case (RedWhileFalse b s c)
    from ‹interpret b s = Some false›
    have "while (b) c  while (b) c,s,0  Skip,s,1"
      by(rule StepWhileFalse)
    have "labels (while (b) c) 1 Skip" by(rule Labels_WhileExit)
    with while (b) c  while (b) c,s,0  Skip,s,1 show ?case by auto
  qed
next
  case (Labels_LAss V e)
  from Skip,s  c',s' have False by(auto elim:red.cases)
  thus ?case by simp
next
  case (Labels_Seq1 c1 l c c2)
  note IH = c'. c,s  c',s' 
        l'. c1  c,s,l  c',s',l'  labels c1 l' c'
  from c;;c2,s  c',s' 
  have "(c = Skip  c' = c2  s = s')  (c''. c' = c'';;c2)"
    by -(erule red.cases,auto)
  thus ?case
  proof
    assume [simp]:"c = Skip  c' = c2  s = s'"
    from ‹labels c1 l c have "l < #:c1"
      by(rule label_less_num_inner_nodes[simplified])
    have "labels (c1;;c2) (0 + #:c1) c2"
      by(rule Labels_Seq2,rule Labels_Base)
    from ‹labels c1 l c have "labels (c1;; c2) l (Skip;;c2)"
      by(fastforce intro:Labels.Labels_Seq1)
    with ‹labels (c1;;c2) (0 + #:c1) c2 l < #:c1 
    have "c1;; c2  Skip;;c2,s,l  c2,s,#:c1"
      by(fastforce intro:StepSeq)
    with ‹labels (c1;;c2) (0 + #:c1) c2 show ?case by auto
  next
    assume "c''. c' = c'';;c2"
    then obtain c'' where [simp]:"c' = c'';;c2" by blast
    have "c2  c'';; c2"
      by (induction c2) auto
    with c;;c2,s  c',s' have "c,s  c'',s'"
      by (auto elim!:red.cases)
    from IH[OF this] obtain l' where "c1  c,s,l  c'',s',l'"
      and "labels c1 l' c''" by blast
    from c1  c,s,l  c'',s',l' have "c1;;c2  c;;c2,s,l  c'';;c2,s',l'"
      by(rule StepRecSeq1)
    from ‹labels c1 l' c'' have "labels (c1;;c2) l' (c'';;c2)"
      by(rule Labels.Labels_Seq1)
    with c1;;c2  c;;c2,s,l  c'';;c2,s',l' show ?case by auto
  qed
next
  case (Labels_Seq2 c2 l c c1 c')
  note IH = c'. c,s  c',s' 
            l'. c2  c,s,l  c',s',l'  labels c2 l' c'
  from IH[OF c,s  c',s'] obtain l' where "c2  c,s,l  c',s',l'"
    and "labels c2 l' c'" by blast
  from c2  c,s,l  c',s',l' have "c1;; c2  c,s,l + #:c1  c',s',l' + #:c1"
    by(rule StepRecSeq2)
  moreover
  from ‹labels c2 l' c' have "labels (c1;;c2) (l' + #:c1) c'"
    by(rule Labels.Labels_Seq2)
  ultimately show ?case by blast
next
  case (Labels_CondTrue c1 l c b c2 c')
  note label = ‹labels c1 l c and red = c,s  c',s'
    and IH = c'. c,s  c',s' 
                   l'. c1  c,s,l  c',s',l'  labels c1 l' c'
  from IH[OF c,s  c',s'] obtain l' where "c1  c,s,l  c',s',l'"
    and "labels c1 l' c'" by blast
  from c1  c,s,l  c',s',l'
  have "if (b) c1 else c2  c,s,l + 1  c',s',l' + 1"
    by(rule StepRecCond1)
  moreover
  from ‹labels c1 l' c' have "labels (if (b) c1 else c2) (l' + 1) c'"
    by(rule Labels.Labels_CondTrue)
  ultimately show ?case by blast
next
  case (Labels_CondFalse c2 l c b c1 c')
  note IH = c'. c,s  c',s' 
            l'. c2  c,s,l  c',s',l'  labels c2 l' c'
  from IH[OF c,s  c',s'] obtain l' where "c2  c,s,l  c',s',l'"
    and "labels c2 l' c'" by blast
  from c2  c,s,l  c',s',l'
  have "if (b) c1 else c2  c,s,l + #:c1 + 1  c',s',l' + #:c1 + 1"
    by(rule StepRecCond2)
  moreover
  from ‹labels c2 l' c' have "labels (if (b) c1 else c2) (l' + #:c1 + 1) c'"
    by(rule Labels.Labels_CondFalse)
  ultimately show ?case by blast
next
  case (Labels_WhileBody c' l c b cx)
  note IH = c''. c,s  c'',s' 
            l'. c'  c,s,l  c'',s',l'  labels c' l' c''
  from c;;while (b) c',s  cx,s'
  have "(c = Skip  cx = while (b) c'  s = s')  (c''. cx = c'';;while (b) c')"
    by -(erule red.cases,auto)
  thus ?case
  proof
    assume [simp]:"c = Skip  cx = while (b) c'  s = s'"
    have "labels (while (b) c') 0 (while (b) c')"
      by(fastforce intro:Labels_Base)
    from ‹labels c' l c have "labels (while (b) c') (l + 2) (Skip;;while (b) c')"
      by(fastforce intro:Labels.Labels_WhileBody simp del:add_2_eq_Suc')
    hence "while (b) c'  Skip;;while (b) c',s,l + 2  while (b) c',s,0"
      by(rule StepSeqWhile)
    with ‹labels (while (b) c') 0 (while (b) c') show ?case by simp blast
  next
    assume "c''. cx = c'';;while (b) c'"
    then obtain c'' where [simp]:"cx = c'';;while (b) c'" by blast
    with c;;while (b) c',s  cx,s' have "c,s  c'',s'"
      by(auto elim:red.cases)
    from IH[OF this] obtain l' where "c'  c,s,l  c'',s',l'"
      and "labels c' l' c''" by blast
    from c'  c,s,l  c'',s',l' 
    have "while (b) c'  c;;while (b) c',s,l + 2  c'';;while (b) c',s',l' + 2"
      by(rule StepRecWhile)
    moreover
    from ‹labels c' l' c'' have "labels (while (b) c') (l' + 2) (c'';;while (b) c')"
      by(rule Labels.Labels_WhileBody)
    ultimately show ?case by simp blast
  qed
next
  case (Labels_WhileExit b c' c'')
  from Skip,s  c'',s' have False by(auto elim:red.cases)
  thus ?case by simp
qed


lemma reds_steps:
  "c,s →* c',s'; labels prog l c
   l'. prog  c,s,l ↝* c',s',l'  labels prog l' c'"
proof(induct rule:rtranclp_induct2)
  case refl
  from ‹labels prog l c show ?case by blast
next
  case (step c'' s'' c' s')
  note IH = ‹labels prog l c     
    l'. prog  c,s,l ↝* c'',s'',l'  labels prog l' c''
  from IH[OF ‹labels prog l c] obtain l'' where "prog  c,s,l ↝* c'',s'',l''"
    and "labels prog l'' c''" by blast
  from ‹labels prog l'' c'' c'',s''  c',s' obtain l'
    where "prog  c'',s'',l''  c',s',l'"
    and "labels prog l' c'" by(auto dest:red_step)
  from prog  c,s,l ↝* c'',s'',l'' prog  c'',s'',l''  c',s',l'
  have "prog  c,s,l ↝* c',s',l'"
    by(fastforce elim:rtranclp_trans)
  with ‹labels prog l' c' show ?case by blast
qed

subsubsection ‹The bisimulation theorem›

theorem reds_steps_bisimulation:
  "labels prog l c  (c,s →* c',s') = 
     (l'. prog  c,s,l ↝* c',s',l'  labels prog l' c')"
  by(fastforce intro:reds_steps elim:steps_reds)

end

Theory WEquivalence

section ‹Equivalence›

theory WEquivalence imports Semantics WCFG begin


subsection ‹From @{term "prog  c,s,l  c',s',l'"} to\\
  @{term "c  (_ l _) -et (_ l' _)"} with @{term transfers} and @{term preds}

lemma Skip_WCFG_edge_Exit:
  "labels prog l Skip  prog  (_ l _) -id (_Exit_)"
proof(induct prog l Skip rule:labels.induct)
  case Labels_Base
  show ?case by(fastforce intro:WCFG_Skip)
next
  case (Labels_LAss V e)
  show ?case by(rule WCFG_LAssSkip)
next
  case (Labels_Seq2 c2 l c1)
  from c2  (_ l _) -id (_Exit_)
  have "c1;;c2  (_ l _)  #:c1 -id (_Exit_)  #:c1"
    by(fastforce intro:WCFG_SeqSecond)
  thus ?case by(simp del:id_apply)
next
  case (Labels_CondTrue c1 l b c2)
  from c1  (_ l _) -id (_Exit_)
  have "if (b) c1 else c2  (_ l _)  1 -id (_Exit_)  1"
    by(fastforce intro:WCFG_CondThen)
  thus ?case by(simp del:id_apply)
next
  case (Labels_CondFalse c2 l b c1)
  from c2  (_ l _) -id (_Exit_)
  have "if (b) c1 else c2  (_ l _)  (#:c1 + 1) -id (_Exit_)  (#:c1 + 1)"
    by(fastforce intro:WCFG_CondElse)
  thus ?case by(simp del:id_apply)
next
  case (Labels_WhileExit b c')
  show ?case by(rule WCFG_WhileFalseSkip)
qed


lemma step_WCFG_edge:
  assumes "prog  c,s,l  c',s',l'"
  obtains et where "prog  (_ l _) -et (_ l' _)" and "transfer et s = s'"
  and "pred et s"
proof -
  from prog  c,s,l  c',s',l'
  have "et. prog  (_ l _) -et (_ l' _)  transfer et s = s'  pred et s"
  proof(induct rule:step.induct)
    case (StepLAss V e s)
    have "pred (λs. s(V:=(interpret e s))) s" by simp
    have "V:=e  (_0_) -(λs. s(V:=(interpret e s))) (_1_)"
      by(rule WCFG_LAss)
    have "transfer (λs. s(V:=(interpret e s))) s = s(V:=(interpret e s))" by simp
    with ‹pred (λs. s(V:=(interpret e s))) s
      V:=e  (_0_) -(λs. s(V:=(interpret e s))) (_1_) show ?case by blast
  next
    case (StepSeq c1 c2 l s)
    from ‹labels (c1;;c2) l (Skip;;c2) l < #:c1 have "labels c1 l Skip"
      by(auto elim:labels.cases intro:Labels_Base)
    hence "c1  (_ l _) -id (_Exit_)" 
      by(fastforce intro:Skip_WCFG_edge_Exit)
    hence "c1;;c2  (_ l _) -id (_0_)  #:c1" 
      by(rule WCFG_SeqConnect,simp)
    thus ?case by auto
  next
    case (StepSeqWhile b cx l s)
    from ‹labels (while (b) cx) l (Skip;;while (b) cx)
    obtain lx where "labels cx lx Skip" 
      and [simp]:"l = lx + 2" by(auto elim:labels.cases)
    hence "cx  (_ lx _) -id (_Exit_)" 
      by(fastforce intro:Skip_WCFG_edge_Exit)
    hence "while (b) cx  (_ lx _)  2 -id (_0_)"
      by(fastforce intro:WCFG_WhileBodyExit)
    thus ?case by auto
  next
    case (StepCondTrue b s c1 c2)
    from ‹interpret b s = Some true›
    have "pred (λs. interpret b s = Some true) s" by simp
    moreover
    have "if (b) c1 else c2  (_0_) -(λs. interpret b s = Some true) (_0_)  1"
      by(rule WCFG_CondTrue)
    moreover
    have "transfer (λs. interpret b s = Some true) s = s" by simp
    ultimately show ?case by auto
  next
    case (StepCondFalse b s c1 c2)
    from ‹interpret b s = Some false›
    have "pred (λs. interpret b s = Some false) s" by simp
    moreover
    have "if (b) c1 else c2  (_0_) -(λs. interpret b s = Some false) 
                                   (_0_)  (#:c1 + 1)"
      by(rule WCFG_CondFalse)
    moreover
    have "transfer (λs. interpret b s = Some false) s = s" by simp
    ultimately show ?case by auto
  next
    case (StepWhileTrue b s c)
    from ‹interpret b s = Some true›
    have "pred (λs. interpret b s = Some true) s" by simp
    moreover
    have "while (b) c  (_0_) -(λs. interpret b s = Some true) (_0_)  2" 
      by(rule WCFG_WhileTrue)
    moreover
    have "transfer (λs. interpret b s = Some true) s = s" by simp
    ultimately show ?case by(auto simp del:add_2_eq_Suc')
  next
    case (StepWhileFalse b s c)
    from ‹interpret b s = Some false›
    have "pred (λs. interpret b s = Some false) s" by simp
    moreover
    have "while (b) c  (_0_) -(λs. interpret b s = Some false) (_1_)"
      by(rule WCFG_WhileFalse)
    moreover
    have "transfer (λs. interpret b s = Some false) s = s" by simp
    ultimately show ?case by auto
  next
    case (StepRecSeq1 prog c s l c' s' l' c2)
    from et. prog  (_ l _) -et (_ l' _)  transfer et s = s'  pred et s
    obtain et where "prog  (_ l _) -et (_ l' _)" 
      and "transfer et s = s'" and "pred et s" by blast
    moreover
    from prog  (_ l _) -et (_ l' _) have "prog;;c2  (_ l _) -et (_ l' _)"
      by(fastforce intro:WCFG_SeqFirst)
    ultimately show ?case by blast
  next
    case (StepRecSeq2 prog c s l c' s' l' c1)
    from et. prog  (_ l _) -et (_ l' _)  transfer et s = s'  pred et s
    obtain et where "prog  (_ l _) -et (_ l' _)" 
      and "transfer et s = s'" and "pred et s" by blast
    moreover
    from prog  (_ l _) -et (_ l' _) 
    have "c1;;prog  (_ l _)  #:c1 -et (_ l' _)  #:c1"
      by(fastforce intro:WCFG_SeqSecond)
    ultimately show ?case by simp blast
  next
    case (StepRecCond1 prog c s l c' s' l' b c2)
    from et. prog  (_ l _) -et (_ l' _)  transfer et s = s'  pred et s
    obtain et where "prog  (_ l _) -et (_ l' _)" 
      and "transfer et s = s'" and "pred et s" by blast
    moreover
    from prog  (_ l _) -et (_ l' _) 
    have "if (b) prog else c2  (_ l _)  1 -et (_ l' _)  1"
      by(fastforce intro:WCFG_CondThen)
    ultimately show ?case by simp blast
  next
    case (StepRecCond2 prog c s l c' s' l' b c1)
    from et. prog  (_ l _) -et (_ l' _)  transfer et s = s'  pred et s
    obtain et where "prog  (_ l _) -et (_ l' _)" 
      and "transfer et s = s'" and "pred et s" by blast
    moreover
    from prog  (_ l _) -et (_ l' _)
    have "if (b) c1 else prog  (_ l _)  (#:c1 + 1) -et (_ l' _)  (#:c1 + 1)"
      by(fastforce intro:WCFG_CondElse)
    ultimately show ?case by simp blast
  next
    case (StepRecWhile cx c s l c' s' l' b)
    from et. cx  (_ l _) -et (_ l' _)  transfer et s = s'  pred et s
    obtain et where "cx  (_ l _) -et (_ l' _)"
      and "transfer et s = s'" and "pred et s" by blast
    moreover
    hence "while (b) cx  (_ l _)  2 -et (_ l' _)  2"
      by(fastforce intro:WCFG_WhileBody)
    ultimately show ?case by simp blast
  qed
  with that show ?thesis by blast
qed


subsection ‹From @{term "c  (_ l _) -et (_ l' _)"} with @{term transfers} 
  and @{term preds} to\\
  @{term "prog  c,s,l  c',s',l'"}

(*<*)declare One_nat_def [simp del] add_2_eq_Suc' [simp del](*>*)

lemma WCFG_edge_Exit_Skip:
  "prog  n -et (_Exit_); n  (_Entry_)
   l. n = (_ l _)  labels prog l Skip  et = id"
proof(induct prog n et "(_Exit_)" rule:WCFG_induct)
  case WCFG_Skip show ?case by(fastforce intro:Labels_Base)
next
  case WCFG_LAssSkip show ?case by(fastforce intro:Labels_LAss)
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = n' = (_Exit_); n  (_Entry_) 
     l. n = (_ l _)  labels c2 l Skip  et = id›
  from n'  #:c1 = (_Exit_) have "n' = (_Exit_)" by(cases n') auto
  from IH[OF this n  (_Entry_)] obtain l where [simp]:"n = (_ l _)" "et = id"
    and "labels c2 l Skip" by blast
  hence "labels (c1;;c2) (l + #:c1) Skip" by(fastforce intro:Labels_Seq2)
  thus ?case by(fastforce simp:id_def)
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = n' = (_Exit_); n  (_Entry_)
     l. n = (_ l _)  labels c1 l Skip  et = id›
  from n'  1 = (_Exit_) have "n' = (_Exit_)" by(cases n') auto
  from IH[OF this n  (_Entry_)] obtain l where [simp]:"n = (_ l _)" "et = id"
    and "labels c1 l Skip" by blast
  hence "labels (if (b) c1 else c2) (l + 1) Skip"
    by(fastforce intro:Labels_CondTrue)
  thus ?case by(fastforce simp:id_def)
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = n' = (_Exit_); n  (_Entry_)
     l. n = (_ l _)  labels c2 l Skip  et = id›
  from n'  #:c1 + 1 = (_Exit_) have "n' = (_Exit_)" by(cases n') auto
  from IH[OF this n  (_Entry_)] obtain l where [simp]:"n = (_ l _)" "et = id"
    and label:"labels c2 l Skip" by blast
  hence "labels (if (b) c1 else c2) (l + #:c1 + 1) Skip"
    by(fastforce intro:Labels_CondFalse)
  thus ?case by(fastforce simp:add.assoc id_def)
next
  case WCFG_WhileFalseSkip show ?case by(fastforce intro:Labels_WhileExit)
next
  case (WCFG_WhileBody c' n et n' b) thus ?case by(cases n') auto
qed simp_all


lemma WCFG_edge_step:
  "prog  (_ l _) -et (_ l' _); transfer et s = s'; pred et s
   c c'. prog  c,s,l  c',s',l'  labels prog l c  labels prog l' c'"
proof(induct prog "(_ l _)" et "(_ l' _)" arbitrary:l l' rule:WCFG_induct)
  case (WCFG_LAss V e)
  from ‹transfer λs. s(V:=(interpret e s)) s = s'
  have [simp]:"s' = s(V:=(interpret e s))" by(simp del:fun_upd_apply)
  have "labels (V:=e) 0 (V:=e)" by(fastforce intro:Labels_Base)
  moreover
  hence "labels (V:=e) 1 Skip" by(fastforce intro:Labels_LAss)
  ultimately show ?case
    apply(rule_tac x="V:=e" in exI)
    apply(rule_tac x="Skip" in exI)
    by(fastforce intro:StepLAss simp del:fun_upd_apply)
next
  case (WCFG_SeqFirst c1 et c2)
  note IH = transfer et s = s'; pred et s
     c c'. c1  c,s,l  c',s',l'  labels c1 l c  labels c1 l' c'
  from IH[OF ‹transfer et s = s' ‹pred et s]
  obtain c c' where "c1  c,s,l  c',s',l'"
    and "labels c1 l c" and "labels c1 l' c'" by blast
  from c1  c,s,l  c',s',l' have "c1;;c2  c;;c2,s,l  c';;c2,s',l'"
    by(rule StepRecSeq1)
  moreover 
  from ‹labels c1 l c have "labels (c1;;c2) l (c;;c2)"
    by(fastforce intro:Labels_Seq1)
  moreover 
  from ‹labels c1 l' c' have "labels (c1;;c2) l' (c';;c2)"
    by(fastforce intro:Labels_Seq1)
  ultimately show ?case by blast
next
  case (WCFG_SeqConnect c1 et c2)
  from c1  (_ l _) -et (_Exit_)
  have "labels c1 l Skip" and [simp]:"et = id"
    by(auto dest:WCFG_edge_Exit_Skip)
  from ‹transfer et s = s' have [simp]:"s' = s" by simp
  have "labels c2 0 c2" by(fastforce intro:Labels_Base)
  hence "labels (c1;;c2) #:c1 c2" by(fastforce dest:Labels_Seq2)
  moreover
  from ‹labels c1 l Skip› have "labels (c1;;c2) l (Skip;;c2)"
    by(fastforce intro:Labels_Seq1)
  moreover
  from ‹labels c1 l Skip› have "l < #:c1" by(rule label_less_num_inner_nodes)
  ultimately 
  have "c1;;c2  Skip;;c2,s,l  c2,s,#:c1" by -(rule StepSeq)
  with ‹labels (c1;;c2) l (Skip;;c2)
    ‹labels (c1;;c2) #:c1 c2 (_0_)  #:c1 = (_ l' _) show ?case by simp blast
next
  case (WCFG_SeqSecond c2 n et n' c1)
  note IH = l l'. n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s
     c c'. c2  c,s,l  c',s',l'  labels c2 l c  labels c2 l' c'
  from n  #:c1 = (_ l _) obtain lx where "n = (_ lx _)" 
    and [simp]:"l = lx + #:c1"
    by(cases n) auto
  from n'  #:c1 = (_ l' _) obtain lx' where "n' = (_ lx' _)" 
    and [simp]:"l' = lx' + #:c1"
    by(cases n') auto
  from IH[OF n = (_ lx _) n' = (_ lx' _) ‹transfer et s = s' ‹pred et s]
  obtain c c' where "c2  c,s,lx  c',s',lx'"
    and "labels c2 lx c" and "labels c2 lx' c'" by blast
  from c2  c,s,lx  c',s',lx' have "c1;;c2  c,s,l  c',s',l'"
    by(fastforce intro:StepRecSeq2)
  moreover 
  from ‹labels c2 lx c have "labels (c1;;c2) l c" by(fastforce intro:Labels_Seq2)
  moreover 
  from ‹labels c2 lx' c' have "labels (c1;;c2) l' c'" by(fastforce intro:Labels_Seq2)
  ultimately show ?case by blast
next
  case (WCFG_CondTrue b c1 c2)
  from (_0_)  1 = (_ l' _) have [simp]:"l' = 1" by simp
  from ‹transfer (λs. interpret b s = Some true) s = s' have [simp]:"s' = s" by simp
  have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)"
    by(fastforce intro:Labels_Base)
  have "labels c1 0 c1" by(fastforce intro:Labels_Base)
  hence "labels (if (b) c1 else c2) 1 c1" by(fastforce dest:Labels_CondTrue)
  from ‹pred (λs. interpret b s = Some true) s
  have "interpret b s = Some true" by simp
  hence "if (b) c1 else c2  if (b) c1 else c2,s,0  c1,s,1"
    by(rule StepCondTrue)
  with  ‹labels (if (b) c1 else c2) 0 (if (b) c1 else c2)
    ‹labels (if (b) c1 else c2) 1 c1 show ?case by simp blast
next
  case (WCFG_CondFalse b c1 c2)
  from (_0_)  #:c1 + 1 = (_ l' _) have [simp]:"l' = #:c1 + 1" by simp
  from ‹transfer (λs. interpret b s = Some false) s = s' have [simp]:"s' = s"
    by simp
  have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)"
    by(fastforce intro:Labels_Base)
  have "labels c2 0 c2" by(fastforce intro:Labels_Base)
  hence "labels (if (b) c1 else c2) (#:c1 + 1) c2" by(fastforce dest:Labels_CondFalse)
  from ‹pred (λs. interpret b s = Some false) s
  have "interpret b s = Some false" by simp
  hence "if (b) c1 else c2  if (b) c1 else c2,s,0  c2,s,#:c1 + 1"
    by(rule StepCondFalse)
  with ‹labels (if (b) c1 else c2) 0 (if (b) c1 else c2)
    ‹labels (if (b) c1 else c2) (#:c1 + 1) c2 show ?case by simp blast
next
  case (WCFG_CondThen c1 n et n' b c2)
  note IH = l l'. n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s
     c c'. c1  c,s,l  c',s',l'  labels c1 l c  labels c1 l' c'
  from n  1 = (_ l _) obtain lx where "n = (_ lx _)" and [simp]:"l = lx + 1"
    by(cases n) auto
  from n'  1 = (_ l' _) obtain lx' where "n' = (_ lx' _)" and [simp]:"l' = lx' + 1"
    by(cases n') auto
  from IH[OF n = (_ lx _) n' = (_ lx' _) ‹transfer et s = s' ‹pred et s]
  obtain c c'  where "c1  c,s,lx  c',s',lx'"
    and "labels c1 lx c" and "labels c1 lx' c'" by blast
  from c1  c,s,lx  c',s',lx' have "if (b) c1 else c2  c,s,l  c',s',l'"
    by(fastforce intro:StepRecCond1)
  moreover 
  from ‹labels c1 lx c have "labels (if (b) c1 else c2) l c"
    by(fastforce intro:Labels_CondTrue)
  moreover 
  from ‹labels c1 lx' c' have "labels (if (b) c1 else c2) l' c'"
    by(fastforce intro:Labels_CondTrue)
  ultimately show ?case by blast
next
  case (WCFG_CondElse c2 n et n' b c1)
  note IH = l l'. n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s
     c c'. c2  c,s,l  c',s',l'  labels c2 l c  labels c2 l' c'
  from n  #:c1 + 1 = (_ l _) obtain lx where "n = (_ lx _)" 
    and [simp]:"l = lx + #:c1 + 1"
    by(cases n) auto
  from n'  #:c1 + 1 = (_ l' _) obtain lx' where "n' = (_ lx' _)" 
    and [simp]:"l' = lx' + #:c1 + 1"
    by(cases n') auto
  from IH[OF n = (_ lx _) n' = (_ lx' _) ‹transfer et s = s' ‹pred et s]
  obtain c c' where "c2  c,s,lx  c',s',lx'"
    and "labels c2 lx c" and "labels c2 lx' c'" by blast
  from c2  c,s,lx  c',s',lx' have "if (b) c1 else c2  c,s,l  c',s',l'"
    by(fastforce intro:StepRecCond2)
  moreover 
  from ‹labels c2 lx c have "labels (if (b) c1 else c2) l c"
    by(fastforce intro:Labels_CondFalse)
  moreover 
  from ‹labels c2 lx' c' have "labels (if (b) c1 else c2) l' c'"
    by(fastforce intro:Labels_CondFalse)
  ultimately show ?case by blast
next
  case (WCFG_WhileTrue b cx)
  from (_0_)  2 = (_ l' _) have [simp]:"l' = 2" by simp
  from ‹transfer (λs. interpret b s = Some true) s = s' have [simp]:"s' = s" by simp
  have "labels (while (b) cx) 0 (while (b) cx)"
    by(fastforce intro:Labels_Base)
  have "labels cx 0 cx" by(fastforce intro:Labels_Base)
  hence "labels (while (b) cx) 2 (cx;;while (b) cx)"
    by(fastforce dest:Labels_WhileBody)
  from ‹pred (λs. interpret b s = Some true) s have "interpret b s = Some true" by simp
  hence "while (b) cx  while (b) cx,s,0  cx;;while (b) cx,s,2"
    by(rule StepWhileTrue)
  with ‹labels (while (b) cx) 0 (while (b) cx)
    ‹labels (while (b) cx) 2 (cx;;while (b) cx) show ?case by simp blast
next
  case (WCFG_WhileFalse b cx)
  from ‹transfer (λs. interpret b s = Some false) s = s' have [simp]:"s' = s"
    by simp
  have "labels (while (b) cx) 0 (while (b) cx)" by(fastforce intro:Labels_Base)
  have "labels (while (b) cx) 1 Skip" by(fastforce intro:Labels_WhileExit)
  from ‹pred (λs. interpret b s = Some false) s have "interpret b s = Some false"
    by simp
  hence "while (b) cx  while (b) cx,s,0  Skip,s,1"
    by(rule StepWhileFalse)
  with ‹labels (while (b) cx) 0 (while (b) cx) ‹labels (while (b) cx) 1 Skip›
  show ?case by simp blast
next
  case (WCFG_WhileBody cx n et n' b)
  note IH = l l'. n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s
     c c'. cx  c,s,l  c',s',l'  labels cx l c  labels cx l' c'
  from n  2 = (_ l _) obtain lx where "n = (_ lx _)" and [simp]:"l = lx + 2"
    by(cases n) auto
  from n'  2 = (_ l' _) obtain lx' where "n' = (_ lx' _)" 
    and [simp]:"l' = lx' + 2" by(cases n') auto
  from IH[OF n = (_ lx _) n' = (_ lx' _) ‹transfer et s = s' ‹pred et s]
  obtain c c' where "cx  c,s,lx  c',s',lx'"
    and "labels cx lx c" and "labels cx lx' c'" by blast
  hence "while (b) cx  c;;while (b) cx,s,l  c';;while (b) cx,s',l'"
    by(fastforce intro:StepRecWhile)
  moreover 
  from ‹labels cx lx c have "labels (while (b) cx) l (c;;while (b) cx)"
    by(fastforce intro:Labels_WhileBody)
  moreover 
  from ‹labels cx lx' c' have "labels (while (b) cx) l' (c';;while (b) cx)"
    by(fastforce intro:Labels_WhileBody)
  ultimately show ?case by blast
next
  case (WCFG_WhileBodyExit cx n et b)
  from n  2 = (_ l _) obtain lx where [simp]:"n = (_ lx _)" and [simp]:"l = lx + 2"
    by(cases n) auto
  from cx  n -et (_Exit_) have "labels cx lx Skip" and [simp]:"et = id"
    by(auto dest:WCFG_edge_Exit_Skip)
  from ‹transfer et s = s' have [simp]:"s' = s" by simp
  from ‹labels cx lx Skip› have "labels (while (b) cx) l (Skip;;while (b) cx)"
    by(fastforce intro:Labels_WhileBody)
  hence "while (b) cx  Skip;;while (b) cx,s,l  while (b) cx,s,0"
    by(rule StepSeqWhile)
  moreover
  have "labels (while (b) cx) 0 (while (b) cx)"
    by(fastforce intro:Labels_Base)
  ultimately show ?case 
    using ‹labels (while (b) cx) l (Skip;;while (b) cx) by simp blast
qed


end

Theory SemanticsWellFormed

section ‹Semantic well-formedness of While CFG›

theory SemanticsWellFormed 
  imports WellFormed WEquivalence "../Basic/SemanticsCFG" 
begin

subsection ‹Instatiation of the CFG_semantics_wf› locale›

fun labels_nodes :: "cmd  w_node  cmd  bool" where
  "labels_nodes prog (_ l _) c     = labels prog l c"
  | "labels_nodes prog (_Entry_) c = False"
  | "labels_nodes prog (_Exit_) c  = False"


interpretation While_semantics_CFG_wf: CFG_semantics_wf 
  sourcenode targetnode kind "valid_edge prog" Entry reds "labels_nodes prog"
  for prog
proof(unfold_locales)
  fix n c s c' s' n'
  assume "labels_nodes prog n c" and "c,s →* c',s'"
  then obtain l l' where [simp]:"n = (_ l _)" and "prog  c,s,l ↝* c',s',l'"
    and "labels prog l' c'" by(cases n,auto dest:reds_steps)
  from ‹labels prog l' c' have "l' < #:prog" by(rule label_less_num_inner_nodes)
  from prog  c,s,l ↝* c',s',l' 
  have "as. CFG.path sourcenode targetnode (valid_edge prog)
    (_ l _) as (_ l' _) 
    transfers (CFG.kinds kind as) s = s'  preds (CFG.kinds kind as) s"
    proof(induct rule:converse_rtranclp_induct3)
      case refl
      from l' < #:prog have "valid_node prog (_ l' _)"
        by(fastforce dest:less_num_nodes_edge simp:valid_node_def valid_edge_def)
      hence "CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l' _)"
        by(simp add:valid_node_def While_CFG.valid_node_def)
      hence "CFG.path sourcenode targetnode (valid_edge prog) (_ l' _) [] (_ l' _)"
        by(rule While_CFG.empty_path)
      thus ?case by(auto simp:While_CFG.kinds_def)
    next
      case (step c s l c'' s'' l'')
      from (λ(c, s, l) (c', s', l'). 
        prog  c,s,l  c',s',l') (c,s,l) (c'',s'',l'')
      have "prog  c,s,l  c'',s'',l''" by simp
      from as. CFG.path sourcenode targetnode (valid_edge prog)
        (_ l'' _) as (_ l' _) 
       transfers (CFG.kinds kind as) s'' = s' 
       preds (CFG.kinds kind as) s''
      obtain as where "CFG.path sourcenode targetnode (valid_edge prog)
        (_ l'' _) as (_ l' _)"
        and "transfers (CFG.kinds kind as) s'' = s'"
        and "preds (CFG.kinds kind as) s''" by auto
      from prog  c,s,l  c'',s'',l'' obtain et 
        where "prog  (_ l _) -et (_ l'' _)"
        and "transfer et s = s''" and "pred et s"
        by(erule step_WCFG_edge)
      from prog  (_ l _) -et (_ l'' _)
        ‹CFG.path sourcenode targetnode (valid_edge prog) (_ l'' _) as (_ l' _) 
      have "CFG.path sourcenode targetnode (valid_edge prog)
        (_ l _) (((_ l _),et,(_ l'' _))#as) (_ l' _)"
        by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
      moreover
      from ‹transfers (CFG.kinds kind as) s'' = s' ‹transfer et s = s''
      have "transfers (CFG.kinds kind (((_ l _),et,(_ l'' _))#as)) s = s'"
        by(simp add:While_CFG.kinds_def)
      moreover from ‹preds (CFG.kinds kind as) s'' ‹pred et s ‹transfer et s = s''
      have "preds (CFG.kinds kind (((_ l _),et,(_ l'' _))#as)) s"
        by(simp add:While_CFG.kinds_def)
      ultimately show ?case by blast
    qed
  with ‹labels prog l' c'
  show "(n' as. 
         CFG.path sourcenode targetnode (valid_edge prog) n as n' 
         transfers (CFG.kinds kind as) s = s' 
         preds (CFG.kinds kind as) s  labels_nodes prog n' c')"
    by(rule_tac x="(_ l' _)" in exI,simp)
qed

end

Theory StaticControlDependences

section ‹Interpretations of the various static control dependences›

theory StaticControlDependences imports 
  AdditionalLemmas 
  SemanticsWellFormed
begin

lemma WhilePostdomination_aux:
  "Postdomination sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
  fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
  hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
  thus "as. prog  (_Entry_) -as→* n" by(rule valid_node_Entry_path)
next
  fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
  hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
  thus "as. prog  n -as→* (_Exit_)" by(rule valid_node_Exit_path)
qed

interpretation WhilePostdomination: 
  Postdomination sourcenode targetnode kind "valid_edge prog" Entry Exit
by(rule WhilePostdomination_aux)


lemma WhileStrongPostdomination_aux:
  "StrongPostdomination sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
  fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
  hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
  show "finite {n'. a'. valid_edge prog a'  sourcenode a' = n 
                         targetnode a' = n'}"
    by(rule finite_successors)
qed

interpretation WhileStrongPostdomination: 
  StrongPostdomination sourcenode targetnode kind "valid_edge prog" Entry Exit
by(rule WhileStrongPostdomination_aux)


subsection ‹Standard Control Dependence›

lemma WStandardControlDependence_aux:
  "StandardControlDependencePDG sourcenode targetnode kind (valid_edge prog)
  Entry (Defs prog) (Uses prog) id Exit"
by(unfold_locales)

interpretation WStandardControlDependence:
  StandardControlDependencePDG sourcenode targetnode kind "valid_edge prog"
                    Entry "Defs prog" "Uses prog" id Exit
  by(rule WStandardControlDependence_aux)


lemma Fundamental_property_scd_aux: "BackwardSlice_wf sourcenode targetnode kind 
  (valid_edge prog) Entry (Defs prog) (Uses prog) id 
  (WStandardControlDependence.PDG_BS_s prog) reds (labels_nodes prog)"
proof -
  interpret BackwardSlice sourcenode targetnode kind "valid_edge prog" Entry
    "Defs prog" "Uses prog" id
    "StandardControlDependencePDG.PDG_BS_s sourcenode targetnode
    (valid_edge prog) (Defs prog) (Uses prog) Exit"
    by(rule WStandardControlDependence.PDGBackwardSliceCorrect)
  show ?thesis by(unfold_locales)
qed

interpretation Fundamental_property_scd: BackwardSlice_wf sourcenode targetnode kind 
  "valid_edge prog" Entry "Defs prog" "Uses prog" id 
  "WStandardControlDependence.PDG_BS_s prog" reds "labels_nodes prog"
  by(rule Fundamental_property_scd_aux)


subsection ‹Weak Control Dependence›

lemma WWeakControlDependence_aux:
  "WeakControlDependencePDG sourcenode targetnode kind (valid_edge prog)
  Entry (Defs prog) (Uses prog) id Exit"
by(unfold_locales)

interpretation WWeakControlDependence:
  WeakControlDependencePDG sourcenode targetnode kind "valid_edge prog"
                    Entry "Defs prog" "Uses prog" id Exit
  by(rule WWeakControlDependence_aux)


lemma Fundamental_property_wcd_aux: "BackwardSlice_wf sourcenode targetnode kind 
  (valid_edge prog) Entry (Defs prog) (Uses prog) id 
  (WWeakControlDependence.PDG_BS_w prog) reds (labels_nodes prog)"
proof -
  interpret BackwardSlice sourcenode targetnode kind "valid_edge prog" Entry
    "Defs prog" "Uses prog" id
    "WeakControlDependencePDG.PDG_BS_w sourcenode targetnode
    (valid_edge prog) (Defs prog) (Uses prog) Exit"
    by(rule WWeakControlDependence.WeakPDGBackwardSliceCorrect)
  show ?thesis by(unfold_locales)
qed

interpretation Fundamental_property_wcd: BackwardSlice_wf sourcenode targetnode kind 
  "valid_edge prog" Entry "Defs prog" "Uses prog" id 
  "WWeakControlDependence.PDG_BS_w prog" reds "labels_nodes prog"
  by(rule Fundamental_property_wcd_aux)


subsection ‹Weak Order Dependence›

lemma Fundamental_property_wod_aux: "BackwardSlice_wf sourcenode targetnode kind 
  (valid_edge prog) Entry (Defs prog) (Uses prog) id 
  (While_CFG_wf.wod_backward_slice prog) reds (labels_nodes prog)"
proof -
  interpret BackwardSlice sourcenode targetnode kind "valid_edge prog" Entry
    "Defs prog" "Uses prog" id
    "CFG_wf.wod_backward_slice sourcenode targetnode (valid_edge prog)
    (Defs prog) (Uses prog)"
    by(rule While_CFG_wf.WODBackwardSliceCorrect)
  show ?thesis by(unfold_locales)
qed

interpretation Fundamental_property_wod: BackwardSlice_wf sourcenode targetnode kind 
  "valid_edge prog" Entry "Defs prog" "Uses prog" id 
  "While_CFG_wf.wod_backward_slice prog" reds "labels_nodes prog"
  by(rule Fundamental_property_wod_aux)

end

Theory JVMCFG

(* This work was done by Denis Lohner (denis.lohner@kit.edu). *)

chapter ‹A Control Flow Graph for Jinja Byte Code›

section ‹Formalizing the CFG›

theory JVMCFG imports "../Basic/BasicDefs" Jinja.BVExample begin


declare lesub_list_impl_same_size [simp del]
declare listE_length [simp del]

subsection ‹Type definitions›

subsubsection ‹Wellformed Programs›

definition "wf_jvmprog = {(P, Phi). wf_jvm_progPhi P}"

typedef wf_jvmprog = wf_jvmprog
proof
  show "(E, Phi)  wf_jvmprog"
    unfolding wf_jvmprog_def by (auto intro: wf_prog)
qed

hide_const Phi E

abbreviation rep_jvmprog_jvm_prog :: "wf_jvmprog  jvm_prog"
("_wf")
  where "Pwf  fst(Rep_wf_jvmprog(P))"

abbreviation rep_jvmprog_phi :: "wf_jvmprog  tyP"
("_Φ")
  where "PΦ  snd(Rep_wf_jvmprog(P))"

lemma wf_jvmprog_is_wf: "wf_jvm_progPΦ (Pwf)"
using Rep_wf_jvmprog [of P]
  by (auto simp: wf_jvmprog_def split_beta)

subsubsection ‹Basic Types›

text ‹
We consider a program to be a well-formed Jinja program,
together with a given base class and a main method
›

type_synonym jvmprog = "wf_jvmprog × cname × mname"
type_synonym callstack = "(cname × mname × pc) list"

text ‹
The state is modeled as $\textrm{heap} \times \textrm{stack-variables} \times \textrm{local-variables}$

stack and local variables are modeled as pairs of natural numbers. The first number
gives the position in the call stack (i.e. the method in which the variable is used),
the second the position in the method's stack or array of local variables resp.

The stack variables are numbered from bottom up (which is the reverse order of the
array for the stack in Jinja's state representation), whereas local variables are identified
by their position in the array of local variables of Jinja's state representation.
›

type_synonym state = "heap × ((nat × nat)  val) × ((nat × nat)  val)"


abbreviation heap_of :: "state  heap"
where
  "heap_of s  fst(s)"

abbreviation stk_of :: "state  ((nat × nat)  val)"
where
  "stk_of s  fst(snd(s))"

abbreviation loc_of :: "state  ((nat × nat)  val)"
where
  "loc_of s  snd(snd(s))"


subsection ‹Basic Definitions›

subsubsection ‹State update (instruction execution)›

text ‹
This function models instruction execution for our state representation.

Additional parameters are the call depth of the current program point,
the stack length of the current program point,
the length of the stack in the underlying call frame (needed for {\sc Return}),
and (for {\sc Invoke}) the length of the array of local variables of the invoked method.

Exception handling is not covered by this function.
›

fun exec_instr :: "instr  wf_jvmprog  state  nat  nat  nat  nat  state"
where
  exec_instr_Load:
  "exec_instr (Load n) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s
   in (h, stk((calldepth,stk_length):=loc(calldepth,n)), loc))"

| exec_instr_Store:
  "exec_instr (Store n) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s
   in (h, stk, loc((calldepth,n):=stk(calldepth,stk_length - 1))))"

| exec_instr_Push:
  "exec_instr (Push v) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s
   in (h, stk((calldepth,stk_length):=v), loc))"

| exec_instr_New:
  "exec_instr (New C) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    a = the(new_Addr h)
   in (h(a  (blank (Pwf) C)), stk((calldepth,stk_length):=Addr a), loc))"

| exec_instr_Getfield:
  "exec_instr (Getfield F C) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    a = the_Addr (stk (calldepth,stk_length - 1));
    (D,fs) = the(h a)
   in (h, stk((calldepth,stk_length - 1) := the(fs(F,C))), loc))"

| exec_instr_Putfield:
  "exec_instr (Putfield F C) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    v = stk (calldepth,stk_length - 1);
    a = the_Addr (stk (calldepth,stk_length - 2));
    (D,fs) = the(h a)
   in (h(a  (D,fs((F,C)  v))), stk, loc))"

| exec_instr_Checkcast:
  "exec_instr (Checkcast C) P s calldepth stk_length rs ill = s"

| exec_instr_Pop:
  "exec_instr (Pop) P s calldepth stk_length rs ill = s"

| exec_instr_IAdd:
  "exec_instr (IAdd) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    i1 = the_Intg (stk (calldepth, stk_length - 1));
    i2 = the_Intg (stk (calldepth, stk_length - 2))
   in (h, stk((calldepth, stk_length - 2) := Intg (i1 + i2)), loc))"

| exec_instr_IfFalse:
  "exec_instr (IfFalse b) P s calldepth stk_length rs ill = s"

| exec_instr_CmpEq:
  "exec_instr (CmpEq) P s calldepth stk_length rs ill =
  (let (h,stk,loc) = s;
    v1 = stk (calldepth, stk_length - 1);
    v2 = stk (calldepth, stk_length - 2)
   in (h, stk((calldepth, stk_length - 2) := Bool (v1 = v2)), loc))"

| exec_instr_Goto:
  "exec_instr (Goto i) P s calldepth stk_length rs ill = s"
  
| exec_instr_Throw:
  "exec_instr (Throw) P s calldepth stk_length rs ill = s"

| exec_instr_Invoke:
  "exec_instr (Invoke M n) P s calldepth stk_length rs invoke_loc_length =
  (let (h,stk,loc) = s;
    loc' = (λ(a,b). if (a  Suc calldepth  b  invoke_loc_length) then loc(a,b) else
                      (if (b  n) then stk(calldepth, stk_length - (Suc n - b)) else arbitrary))
   in (h,stk,loc'))"

| exec_instr_Return:
  "exec_instr (Return) P s calldepth stk_length ret_stk_length ill =
  (if (calldepth = 0)
    then s
    else
    (let (h,stk,loc) = s;
      v = stk(calldepth, stk_length - 1)
     in (h,stk((calldepth - 1, ret_stk_length - 1) := v),loc))
  )"


subsubsection ‹length of stack and local variables›

text ‹The following terms extract the stack length at a given program point
from the well-typing of the given program›

abbreviation stkLength :: "wf_jvmprog  cname  mname  pc  nat"
  where
  "stkLength P C M pc  length (fst(the(((PΦ) C M)!pc)))"

abbreviation locLength :: "wf_jvmprog  cname  mname  pc  nat"
  where
  "locLength P C M pc  length (snd(the(((PΦ) C M)!pc)))"


subsubsection ‹Conversion functions›

text ‹
This function takes a natural number n and a function f with domain nat›
and creates the array [f 0, f 1, f 2, ..., f (n - 1)].

This is used for extracting the array of local variables
›

(*
fun locs :: "nat ⇒ (nat ⇒ 'a) ⇒ 'a list"
where
  "locs 0 loc = []"
| "locs (Suc n) loc = (locs n loc)@[loc n]"
*)

abbreviation locs :: "nat  (nat  'a)  'a list"
where "locs n loc  map loc [0..<n]"

text ‹
This function takes a natural number n and a function f with domain nat›
and creates the array [f (n - 1), ..., f 1, f 0].

This is used for extracting the stack as a list
›

(*
fun stks :: "nat ⇒ (nat ⇒ 'a) ⇒ 'a list"
where
  "stks 0 stk = []"
| "stks (Suc n) stk = (stk n)#(stks n stk)"
*)

abbreviation stks :: "nat  (nat  'a)  'a list"
where "stks n stk  map stk (rev [0..<n])"

text ‹
This function creates a list of the arrays for local variables from the given state
corresponding to the given callstack
›

fun locss :: "wf_jvmprog  callstack  ((nat × nat)  'a)  'a list list"
where
  "locss P [] loc = []"
| "locss P ((C,M,pc)#cs) loc =
    (locs (locLength P C M pc) (λa. loc (length cs, a)))#(locss P cs loc)"

text ‹
This function creates a list of the (methods') stacks from the given state
corresponding to the given callstack
›

fun stkss :: "wf_jvmprog  callstack  ((nat × nat)  'a)  'a list list"
where
  "stkss P [] stk = []"
| "stkss P ((C,M,pc)#cs) stk =
  (stks (stkLength P C M pc) (λa. stk (length cs, a)))#(stkss P cs stk)"

text ‹Given a callstack and a state, this abbreviation converts the state
to Jinja's state representation
›

abbreviation state_to_jvm_state :: "wf_jvmprog  callstack  state  jvm_state"
where "state_to_jvm_state P cs s  
  (None, heap_of s, zip (stkss P cs (stk_of s)) (zip (locss P cs (loc_of s)) cs))"

text ‹This function extracts the call stack from a given frame stack (as it is given
by Jinja's state representation)
›

definition framestack_to_callstack :: "frame list  callstack"
where "framestack_to_callstack frs  map snd (map snd frs)"


subsubsection ‹State Conformance›

text ‹Now we lift byte code verifier conformance to our state representation›

definition bv_conform :: "wf_jvmprog  callstack  state  bool"
  ("_,_ BV _ ")
where "P,csBV s   correct_state (Pwf) (PΦ) (state_to_jvm_state P cs s)"


subsubsection ‹Statically determine catch-block›

text ‹This function is equivalent to Jinja's find_handler› function›
fun find_handler_for :: "wf_jvmprog  cname  callstack  callstack"
where
  "find_handler_for P C [] = []"
| "find_handler_for P C (c#cs) = (let (C',M',pc') = c in
     (case match_ex_table (Pwf) C pc' (ex_table_of (Pwf) C' M') of
          None  find_handler_for P C cs
        | Some pc_d  (C', M', fst pc_d)#cs))"


subsection ‹Simplification lemmas›

lemma find_handler_decr [simp]: "find_handler_for P Exc cs  c#cs"
proof
  assume "find_handler_for P Exc cs = c#cs"
  hence "length cs < length (find_handler_for P Exc cs)" by simp
  thus False by (induct cs, auto)
qed

(*
lemma locs_length [simp]: "length (locs n loc) = n"
  by (induct n) auto

lemma stks_length [simp]: "length (stks n stk) = n"
  by (induct n) auto
*)

lemma stkss_length [simp]: "length (stkss P cs stk) = length cs"
  by (induct cs) auto

lemma locss_length [simp]: "length (locss P cs loc) = length cs"
  by (induct cs) auto

(*
lemma nth_stks: "b < n ⟹ stks n stk ! b = stk(n - Suc b)"
  by (auto simp: rev_nth)
proof (induct n arbitrary: b)
  case (0 b)
  thus ?case by simp
next
  case (Suc n b)
  thus ?case
    by (auto simp: nth_Cons' less_Suc_eq)
qed
*)

lemma nth_stkss: 
  " a < length cs; b < length (stkss P cs stk ! (length cs - Suc a)) 
   stkss P cs stk ! (length cs - Suc a) ! 
    (length (stkss P cs stk ! (length cs - Suc a)) - Suc b) = stk (a,b)"
proof (induct cs)
  case Nil
  thus ?case by (simp add: nth_Cons')
next
  case (Cons aa cs)
  thus ?case
    by (cases aa, auto simp add: nth_Cons' rev_nth less_Suc_eq)
qed

(*
lemma nth_locs: "b < n ⟹ locs n loc ! b = loc b"
proof (induct n)
  case 0
  thus ?case by simp
next
  case (Suc n)
  thus ?case
    by (auto simp: nth_append less_Suc_eq)
qed
*)

lemma nth_locss:
  " a < length cs; b < length (locss P cs loc ! (length cs - Suc a)) 
   locss P cs loc ! (length cs - Suc a) ! b = loc (a,b)"
proof (induct cs)
  case Nil
  thus ?case by (simp add: nth_Cons')
next
  case (Cons aa cs)
  thus ?case
    by (cases aa, auto simp: nth_Cons' (* nth_locs *) less_Suc_eq)
qed

lemma hd_stks [simp]: "n  0  hd (stks n stk) = stk(n - 1)"
  by (cases n, simp_all)

lemma hd_tl_stks: "n > 1  hd (tl (stks n stk)) = stk(n - 2)"
  by (cases n, auto)

(*
lemma stks_purge:
  "d ≥ b ⟹ stks b (stk(d := e)) = stks b stk"
  by (induct b, auto)

lemma stks_purge':
  "d ≥ b ⟹ stks b (λx. if x = d then e else stk x) = stks b stk"
  by (fold fun_upd_def, simp only: stks_purge)
*)

lemma stkss_purge:
  "length cs  a  stkss P cs (stk((a,b) := c)) = stkss P cs stk"
  by (induct cs, auto (* simp: stks_purge *))

lemma stkss_purge':
  "length cs  a  stkss P cs (λs. if s = (a, b) then c else stk s) = stkss P cs stk"
  by (fold fun_upd_def, simp only: stkss_purge)

(*
lemma locs_purge:
  "d ≥ b ⟹ locs b (loc(d := e)) = locs b loc"
  by (induct b, auto)

lemma locs_purge':
  "d ≥ b ⟹ locs b (λb. if b = d then e else loc b) = locs b loc"
  by (fold fun_upd_def, simp only: locs_purge)
*)
 
lemma locss_purge:
  "length cs  a  locss P cs (loc((a,b) := c)) = locss P cs loc"
  by (induct cs, auto (*simp: locs_purge *))

lemma locss_purge':
  "length cs  a  locss P cs (λs. if s = (a, b) then c else loc s) = locss P cs loc"
  by (fold fun_upd_def, simp only: locss_purge)

lemma locs_pullout [simp]:
  "locs b (loc(n := e)) = (locs b loc) [n := e]"
proof (induct b)
  case 0
  thus ?case by simp
next
  case (Suc b)
  thus ?case
    by (cases "n - b", auto simp: list_update_append not_less_eq less_Suc_eq)
qed

lemma locs_pullout' [simp]:
  "locs b (λa. if a = n then e else loc (c, a)) = (locs b (λa. loc (c, a))) [n := e]"
  by (fold fun_upd_def) simp

lemma stks_pullout:
  "n < b  stks b (stk(n := e)) = (stks b stk) [b - Suc n := e]"
proof (induct b)
  case 0
  thus ?case by simp
next
  case (Suc b)
  thus ?case
  proof (cases "b = n")
    case True
    with Suc show ?thesis
      by auto
(*      by (auto simp: stks_purge') *)
  next
    case False
    with Suc show ?thesis
      by (cases "b - n") (auto intro!: nth_equalityI simp: nth_list_update)
 qed
qed

lemma nth_tl : "xs  []  tl xs ! n = xs ! (Suc n)"
  by (cases xs, simp_all)

lemma f2c_Nil [simp]: "framestack_to_callstack [] = []"
  by (simp add: framestack_to_callstack_def)

lemma f2c_Cons [simp]:
  "framestack_to_callstack ((stk,loc,C,M,pc)#frs) = (C,M,pc)#(framestack_to_callstack frs)"
  by (simp add: framestack_to_callstack_def)

lemma f2c_length [simp]:
  "length (framestack_to_callstack frs) = length frs"
  by (simp add: framestack_to_callstack_def)

lemma f2c_s2jvm_id [simp]:
  "framestack_to_callstack
    (snd(snd(state_to_jvm_state P cs s))) =
  cs"
  by (cases s, simp add: framestack_to_callstack_def)

lemma f2c_s2jvm_id' [simp]:
  "framestack_to_callstack
  (zip (stkss P cs stk) (zip (locss P cs loc) cs)) = cs"
  by (simp add: framestack_to_callstack_def)

lemma f2c_append [simp]:
  "framestack_to_callstack (frs @ frs') =
  (framestack_to_callstack frs) @ (framestack_to_callstack frs')"
  by (simp add: framestack_to_callstack_def)


subsection ‹CFG construction›

subsection ‹Datatypes›

text ‹Nodes are labeled with a callstack and an optional tuple (consisting of
a callstack and a flag).

The first callstack determines the current program point (i.e. the next statement
to execute). If the second parameter is not None, we are at an intermediate state,
where the target of the instruction is determined (the second callstack)
and the flag is set to whether an exception is thrown or not.
›
datatype j_node =
   Entry  ("'('_Entry'_')")
 | Node "callstack" "(callstack × bool) option" ("'('_ _,_ '_')")

text ‹The empty callstack indicates the exit node›

abbreviation j_node_Exit :: "j_node" ("'('_Exit'_')")
where "j_node_Exit  (_ [],None _)"

text ‹An edge is a triple, consisting of two nodes and the edge kind›

type_synonym j_edge = "(j_node × state edge_kind × j_node)"


subsection ‹CFG›

text ‹
The CFG is constructed by a case analysis on the instructions and
their different behavior in different states. E.g. the exceptional behavior of
{\sc New}, if there is no more space in the heap, vs. the normal behavior.

Note: The set of edges defined by this predicate is a first approximation to the
real set of edges in the CFG. We later (theory JVMInterpretation) add some well-formedness
requirements to the nodes.
›

inductive JVM_CFG :: "jvmprog  j_node  state edge_kind  j_node  bool"
  ("_  _ -_ _")
where
  JCFG_EntryExit:
  "prog  (_Entry_) -(λs. False) (_Exit_)"

| JCFG_EntryStart:
  "prog = (P, C0, Main)  prog  (_Entry_) -(λs. True) (_ [(C0, Main, 0)],None _)"

| JCFG_ReturnExit:
  " prog = (P,C0,Main);
    (instrs_of (Pwf) C M) ! pc = Return 
     prog  (_ [(C, M, pc)],None _) -id (_Exit_)"

| JCFG_Straight_NoExc:
  " prog = (P, C0, Main);
    instrs_of (Pwf) C M ! pc  {Load idx, Store idx, Push val, Pop, IAdd, CmpEq};
    ek = (λs. exec_instr ((instrs_of (Pwf) C M) ! pc) P s
                          (length cs) (stkLength P C M pc) arbitrary arbitrary) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, Suc pc)#cs,None _)"

| JCFG_New_Normal_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (New Cl);
    ek = (λ(h,stk,loc). new_Addr h  None)
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,((C, M, Suc pc)#cs,False) _)"

| JCFG_New_Normal_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (New Cl);
    ek = (λs. exec_instr (New Cl) P s (length cs) (stkLength P C M pc) arbitrary arbitrary) 
     prog  (_ (C, M, pc)#cs,((C, M, Suc pc)#cs, False) _) -ek (_ (C, M, Suc pc)#cs,None _)"

| JCFG_New_Exc_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (New Cl);
    find_handler_for P OutOfMemory ((C, M, pc)#cs) = cs';
    ek = (λ(h,stk,loc). new_Addr h = None) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,(cs',True) _)"

| JCFG_New_Exc_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (New Cl);
    find_handler_for P OutOfMemory ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = (λ(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt OutOfMemory)),
      loc)
     ) 
     prog  (_ (C, M, pc)#cs,((C', M', pc')#cs', True) _) -ek (_ (C', M', pc')#cs',None _)"

| JCFG_New_Exc_Exit:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (New Cl);
    find_handler_for P OutOfMemory ((C, M, pc)#cs) = [] 
     prog  (_ (C, M, pc)#cs,([], True) _) -id (_Exit_)"

| JCFG_Getfield_Normal_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Getfield Fd Cl);
    ek = (λ(h,stk,loc).  stk(length cs, stkLength P C M pc - 1)  Null) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,((C, M, Suc pc)#cs, False) _)"

| JCFG_Getfield_Normal_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Getfield Fd Cl);
    ek = (λs. exec_instr (Getfield Fd Cl) P s (length cs) (stkLength P C M pc)
                          arbitrary arbitrary) 
     prog  (_ (C, M, pc)#cs,((C, M, Suc pc)#cs, False) _) -ek (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Getfield_Exc_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Getfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
    ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Null) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,(cs', True) _)"

| JCFG_Getfield_Exc_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Getfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek =  (λ(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
      loc)
     ) 
     prog  (_ (C, M, pc)#cs,((C', M', pc')#cs', True) _) -ek (_ (C', M', pc')#cs',None _)"

| JCFG_Getfield_Exc_Exit:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Getfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = [] 
     prog  (_ (C, M, pc)#cs,([], True) _) -id (_Exit_)"

| JCFG_Putfield_Normal_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Putfield Fd Cl);
    ek = (λ(h,stk,loc).  stk(length cs, stkLength P C M pc - 2)  Null) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,((C, M, Suc pc)#cs, False) _)"

| JCFG_Putfield_Normal_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Putfield Fd Cl);
    ek = (λs. exec_instr (Putfield Fd Cl) P s (length cs) (stkLength P C M pc)
                          arbitrary arbitrary) 
     prog  (_ (C, M, pc)#cs,((C, M, Suc pc)#cs, False) _) -ek (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Putfield_Exc_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Putfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
    ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2) = Null) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,(cs', True) _)"

| JCFG_Putfield_Exc_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Putfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = (λ(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
      loc)
     ) 
     prog  (_ (C, M, pc)#cs,((C', M', pc')#cs', True) _) -ek (_ (C', M', pc')#cs',None _)"

| JCFG_Putfield_Exc_Exit:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Putfield Fd Cl);
    find_handler_for P NullPointer ((C, M, pc)#cs) = [] 
     prog  (_ (C, M, pc)#cs,([], True) _) -id (_Exit_)"

| JCFG_Checkcast_Normal_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Checkcast Cl);
    ek = (λ(h,stk,loc). cast_ok (Pwf) Cl h (stk(length cs, stkLength P C M pc - Suc 0))) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Checkcast_Exc_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Checkcast Cl);
    find_handler_for P ClassCast ((C, M, pc)#cs) = cs';
    ek = (λ(h,stk,loc). ¬ cast_ok (Pwf) Cl h (stk(length cs, stkLength P C M pc - Suc 0))) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,(cs', True) _)"

| JCFG_Checkcast_Exc_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Checkcast Cl);
    find_handler_for P ClassCast ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = (λ(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt ClassCast)),
      loc)
     ) 
     prog  (_ (C, M, pc)#cs,((C', M', pc')#cs', True) _) -ek (_ (C', M', pc')#cs',None _)"

| JCFG_Checkcast_Exc_Exit:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Checkcast Cl);
    find_handler_for P ClassCast ((C, M, pc)#cs) = [] 
     prog  (_ (C, M, pc)#cs,([], True) _) -id (_Exit_)"

| JCFG_Invoke_Normal_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Invoke M2 n);
    cd = length cs;
    stk_length = stkLength P C M pc;
    ek = (λ(h,stk,loc).
     stk(cd, stk_length - Suc n)  Null 
     fst(method (Pwf) (cname_of h (the_Addr(stk(cd, stk_length - Suc n)))) M2) = D
    ) 
    
      prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,((D, M2, 0)#(C, M, pc)#cs, False) _)"

| JCFG_Invoke_Normal_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Invoke M2 n);
    stk_length = stkLength P C M pc;
    loc_length = locLength P D M2 0;
    ek = (λs. exec_instr (Invoke M2 n) P s (length cs) stk_length arbitrary loc_length)
   
     prog  (_ (C, M, pc)#cs,((D, M2, 0)#(C, M, pc)#cs, False) _) -ek
               (_ (D, M2, 0)#(C, M, pc)#cs,None _)"

| JCFG_Invoke_Exc_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Invoke m2 n);
    find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
    ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - Suc n) = Null) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,(cs', True) _)"

| JCFG_Invoke_Exc_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Invoke M2 n);
    find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
    ek = (λ(h,stk,loc).
     (h,
      stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
      loc)
     )
   
     prog  (_ (C, M, pc)#cs,((C', M', pc')#cs', True) _) -ek (_ (C', M', pc')#cs',None _)"

| JCFG_Invoke_Exc_Exit:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (Invoke M2 n);
    find_handler_for P NullPointer ((C, M, pc)#cs) = [] 
     prog  (_ (C, M, pc)#cs,([], True) _) -id (_Exit_)"

| JCFG_Return_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = Return;
    stk_length = stkLength P C M pc;
    r_stk_length = stkLength P C' M' (Suc pc');
    ek = (λs. exec_instr Return P s (Suc (length cs)) stk_length r_stk_length arbitrary) 
     prog  (_ (C, M, pc)#(C', M', pc')#cs,None _) -ek (_ (C', M', Suc pc')#cs,None _)"

| JCFG_Goto_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = Goto idx 
     prog  (_ (C, M, pc)#cs,None _) -id (_ (C, M, nat (int pc + idx))#cs,None _)"

| JCFG_IfFalse_False:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (IfFalse b);
    b  1;
    ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Bool False) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, nat (int pc + b))#cs,None _)"

| JCFG_IfFalse_Next:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = (IfFalse b);
    ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1)  Bool False  b = 1) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, Suc pc)#cs,None _)"

| JCFG_Throw_Pred:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = Throw;
    cd = length cs;
    stk_length = stkLength P C M pc;
    Exc. find_handler_for P Exc ((C, M, pc)#cs) = cs';
    ek = (λ(h,stk,loc).
      (stk(length cs, stkLength P C M pc - 1) = Null 
        find_handler_for P NullPointer ((C, M, pc)#cs) = cs') 
      (stk(length cs, stkLength P C M pc - 1)  Null 
        find_handler_for P (cname_of h (the_Addr(stk(cd, stk_length - 1)))) ((C, M, pc)#cs) = cs')
    ) 
     prog  (_ (C, M, pc)#cs,None _) -ek (_ (C, M, pc)#cs,(cs', True) _)"

| JCFG_Throw_Update:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = Throw;
    ek = (λ(h,stk,loc).
      (h,
       stk((length cs',(stkLength P C' M' pc') - 1) :=
         if (stk(length cs, stkLength P C M pc - 1) = Null) then
           Addr (addr_of_sys_xcpt NullPointer)
         else (stk(length cs, stkLength P C M pc - 1))),
       loc)
    ) 
     prog  (_ (C, M, pc)#cs,((C', M', pc')#cs', True) _) -ek (_ (C', M', pc')#cs',None _)"

| JCFG_Throw_Exit:
  " prog = (P, C0, Main);
    (instrs_of (Pwf) C M) ! pc = Throw 
     prog  (_ (C, M, pc)#cs,([],True) _) -id (_Exit_)"


subsection ‹CFG properties›

lemma JVMCFG_Exit_no_sourcenode [dest]:
  assumes edge:"prog  (_Exit_) -et n'"
  shows "False"
proof -
  { fix n 
    have "prog  n -et n'; n = (_Exit_)  False"
      by (auto elim!: JVM_CFG.cases)
  }
  with edge show ?thesis by fastforce
qed

lemma JVMCFG_Entry_no_targetnode [dest]:
  assumes edge:"prog  n -et (_Entry_)"
  shows "False"
proof -
  { fix n' have "prog  n -et n'; n' = (_Entry_)  False"
      by (auto elim!: JVM_CFG.cases)
  }
  with edge show ?thesis by fastforce
qed

lemma JVMCFG_EntryD:
  "(P,C,M)  n -et n'; n = (_Entry_) 
   (n' = (_Exit_)  et = (λs. False))  (n' = (_ [(C,M,0)],None _)  et = (λs. True))"
by (erule JVM_CFG.cases) simp_all

declare split_def [simp add]
declare find_handler_for.simps [simp del]

(* The following lemma explores many cases, it takes a little to prove *)
lemma JVMCFG_edge_det:
  "prog  n -et n'; prog  n -et' n'  et = et'"
  by (erule JVM_CFG.cases, (erule JVM_CFG.cases, fastforce+)+)

declare split_def [simp del]
declare find_handler_for.simps [simp add]

end

Theory JVMInterpretation

theory JVMInterpretation imports JVMCFG "../Basic/CFGExit" begin

section ‹Instatiation of the CFG› locale›

abbreviation sourcenode :: "j_edge  j_node"
  where "sourcenode e  fst e"

abbreviation targetnode :: "j_edge  j_node"
  where "targetnode e  snd(snd e)"

abbreviation kind :: "j_edge  state edge_kind"
  where "kind e  fst(snd e)"

text ‹
The following predicates define the aforementioned well-formedness requirements
for nodes. Later, valid_callstack› will be implied by Jinja's state conformance.
›

fun valid_callstack :: "jvmprog  callstack  bool"
where
  "valid_callstack prog [] = True"
| "valid_callstack (P, C0, Main) [(C, M, pc)]  
    C = C0  M = Main 
    (PΦ) C M ! pc  None 
    (T Ts mxs mxl is xt. (Pwf)  C sees M:TsT=(mxs, mxl, is, xt) in C  pc < length is)"
| "valid_callstack (P, C0, Main) ((C, M, pc)#(C', M', pc')#cs) 
    instrs_of (Pwf) C' M' ! pc' =
      Invoke M (locLength P C M 0 - Suc (fst(snd(snd(snd(snd(method (Pwf) C M)))))) ) 
    (PΦ) C M ! pc  None 
    (T Ts mxs mxl is xt. (Pwf)  C sees M:TsT=(mxs, mxl, is, xt) in C  pc < length is) 
    valid_callstack (P, C0, Main) ((C', M', pc')#cs)"

fun valid_node :: "jvmprog  j_node  bool"
where
  "valid_node prog (_Entry_) = True"
(* | "valid_node prog (_Exit_) = True" *)
| "valid_node prog (_ cs,None _)  valid_callstack prog cs"
| "valid_node prog (_ cs,(cs', xf) _) 
    valid_callstack prog cs  valid_callstack prog cs' 
    (Q. prog  (_ cs,None _) -(Q) (_ cs,(cs', xf) _)) 
    (f. prog  (_ cs,(cs', xf) _) -f (_ cs',None _))"

fun valid_edge :: "jvmprog  j_edge  bool"
where
  "valid_edge prog a 
    (prog  (sourcenode a) -(kind a) (targetnode a))
     (valid_node prog (sourcenode a))
     (valid_node prog (targetnode a))"

interpretation JVM_CFG_Interpret:
  CFG "sourcenode" "targetnode" "kind" "valid_edge prog" "Entry"
  for prog
proof (unfold_locales)
  fix a
  assume ve: "valid_edge prog a"
    and trg: "targetnode a = (_Entry_)"
  obtain n et n'
    where "a = (n,et,n')"
    by (cases a) fastforce
  with ve trg 
    have "prog  n -et (_Entry_)" by simp
  thus False by fastforce
next
  fix a a'
  assume valid: "valid_edge prog a"
    and valid': "valid_edge prog a'"
    and sourceeq: "sourcenode a = sourcenode a'"
    and targeteq: "targetnode a = targetnode a'"
  obtain n1 et n2
    where a:"a = (n1, et, n2)"
    by (cases a) fastforce
  obtain n1' et' n2'
    where a':"a' = (n1', et', n2')"
    by (cases a') fastforce
  from a valid a' valid' sourceeq targeteq
  have "et = et'"
    by (fastforce elim: JVMCFG_edge_det)
  with a a' sourceeq targeteq
  show "a = a'"
    by simp
qed


interpretation JVM_CFGExit_Interpret:
  CFGExit "sourcenode" "targetnode" "kind" "valid_edge prog" "Entry" "(_Exit_)"
  for prog
proof(unfold_locales)
  fix a
  assume ve: "valid_edge prog a"
    and src: "sourcenode a = (_Exit_)"
  obtain n et n'
    where "a = (n,et,n')"
    by (cases a) fastforce
  with ve src
    have "prog  (_Exit_) -et n'" by simp
  thus False by fastforce
next
  have "prog  (_Entry_) -(λs. False) (_Exit_)" 
    by (rule JCFG_EntryExit)
  thus "a. valid_edge prog a  sourcenode a = (_Entry_) 
            targetnode a = (_Exit_)  kind a = (λs. False)"
    by fastforce
qed

end

Theory JVMPostdomination

chapter ‹Standard and Weak Control Dependence›

section ‹A type for well-formed programs›

theory JVMPostdomination imports JVMInterpretation "../Basic/Postdomination" begin

text ‹
For instantiating Postdomination› every node in the CFG of a program must be
reachable from the (_Entry_)› node and there must be a path to the
(_Exit_)› node from each node.

Therefore, we restrict the set of allowed programs to those, where the CFG fulfills
these requirements. This is done by defining a new type for well-formed programs.
The universe of every type in Isabelle must be non-empty. That's why we first
define an example program EP› and its typing Phi_EP›, which
is a member of the carrier set of the later defined type.

Restricting the set of allowed programs in this way is reasonable, as Jinja's compiler
only produces byte code programs, that are members of this type (A proof for this is
current work).
›

definition EP :: jvm_prog
  where "EP = (''C'', Object, [], [(''M'', [], Void, 1::nat, 0::nat, [Push Unit, Return], [])]) #
  SystemClasses"

definition Phi_EP :: tyP
  where "Phi_EP C M = (if C = ''C''  M = ''M'' then [([],[OK (Class ''C'')]),([Void],[OK (Class ''C'')])] else [])"

text ‹
Now we show, that EP› is indeed a well-formed program in the sense of Jinja's
byte code verifier
›

lemma distinct_classes'':
  "''C''  Object"
  "''C''  NullPointer"
  "''C''  OutOfMemory"
  "''C''  ClassCast"
  by (simp_all add: Object_def NullPointer_def OutOfMemory_def ClassCast_def)

lemmas distinct_classes =
  distinct_classes distinct_classes'' distinct_classes'' [symmetric]
  
declare distinct_classes [simp add]

lemma i_max_2D: "i < Suc (Suc 0)  i = 0  i = 1"
  by auto

lemma EP_wf: "wf_jvm_progPhi_EP EP"
  unfolding wf_jvm_prog_phi_def wf_prog_def
proof
  show "wf_syscls EP"
    by (simp add: EP_def wf_syscls_def SystemClasses_def sys_xcpts_def
                  ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
next
  have distinct_EP: "distinct_fst EP"
    by (auto simp:
      EP_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
  have classes_wf:
    "cset EP.
        wf_cdecl
         (λP C (M, Ts, Tr, mxs, mxl0, is, xt). wt_method P C Ts Tr mxs mxl0 is xt (Phi_EP C M))
         EP c"
  proof
    fix C
    assume C_in_EP: "C  set EP"
    show "wf_cdecl
         (λP C (M, Ts, Tr, mxs, mxl0, is, xt). wt_method P C Ts Tr mxs mxl0 is xt (Phi_EP C M))
         EP C"
    proof (cases "C  set SystemClasses")
      case True
      thus ?thesis
        by (auto simp: wf_cdecl_def SystemClasses_def ObjectC_def NullPointerC_def
                       OutOfMemoryC_def ClassCastC_def EP_def class_def)
    next
      case False
      with C_in_EP
      have [simp]: "C = (''C'', the (class EP ''C''))"
        by (auto simp: EP_def SystemClasses_def class_def)
      show ?thesis
        apply (auto dest!: i_max_2D
                     simp: wf_cdecl_def class_def EP_def wf_mdecl_def wt_method_def Phi_EP_def
                           wt_start_def check_types_def states_def JVM_SemiType.sl_def
                           stk_esl_def upto_esl_def loc_sl_def SemiType.esl_def
                           SemiType.sup_def Err.sl_def Err.le_def err_def Listn.sl_def
                           Err.esl_def Opt.esl_def Product.esl_def relevant_entries_def)
          apply (fastforce simp: SystemClasses_def ObjectC_def)
         apply (clarsimp simp: Method_def)
         apply (cases rule: Methods.cases,
                (fastforce simp: class_def SystemClasses_def ObjectC_def)+)
        apply (clarsimp simp: Method_def)
        by (cases rule: Methods.cases,
            (fastforce simp: class_def SystemClasses_def ObjectC_def)+)
    qed
  qed
  with distinct_EP
  show "(cset EP.
    wf_cdecl
      (λP C (M, Ts, Tr, mxs, mxl0, is, xt). wt_method P C Ts Tr mxs mxl0 is xt (Phi_EP C M))
      EP c) 
    distinct_fst EP"
    by simp
qed

lemma [simp]: "Abs_wf_jvmprog (EP, Phi_EP)wf = EP"
proof (cases "(EP, Phi_EP)  wf_jvmprog")
  case True
  thus ?thesis
    by (simp add: Abs_wf_jvmprog_inverse)
next
  case False
  with EP_wf
  show ?thesis
    by (simp add: wf_jvmprog_def)
qed

lemma [simp]: "Abs_wf_jvmprog (EP, Phi_EP)Φ = Phi_EP"
proof (cases "(EP, Phi_EP)  wf_jvmprog")
  case True
  thus ?thesis
    by (simp add: Abs_wf_jvmprog_inverse)
next
  case False
  with EP_wf
  show ?thesis
    by (simp add: wf_jvmprog_def)
qed

(*
lemma sees_method_instruct_listD:
  "((C, D, Fds, (((M::char list), (Ts:: ty list), (T:: ty), mxs, mxl, is, xt) # meths) ) # cs) ⊢ C sees M: Tsa→Ta = (mxsa, mxla, isa, xta) in C ⟹ mxsa = mxs ∧ mxla = mxl ∧ xta = xt ∧ isa = is"
apply (clarsimp simp: Method_def)
apply (erule Methods.cases)
 apply (clarsimp simp: class_def)
by (clarsimp simp: class_def)
*)

lemma method_in_EP_is_M:
  "EP  C sees M: TsT = (mxs, mxl, is, xt) in D
   C = ''C'' 
     M = ''M'' 
     Ts = [] 
     T = Void 
     mxs = 1 
     mxl = 0 
     is = [Push Unit, Return] 
     xt = [] 
     D = ''C''"
apply (clarsimp simp: Method_def EP_def)
apply (erule Methods.cases, clarsimp simp: class_def SystemClasses_def ObjectC_def)
apply (clarsimp simp: class_def)
apply (erule Methods.cases)
 by (fastforce simp: class_def SystemClasses_def ObjectC_def NullPointerC_def
                       OutOfMemoryC_def ClassCastC_def if_split_eq1)+

lemma [simp]:
  "T Ts mxs mxl is. (xt. EP  ''C'' sees ''M'': TsT = (mxs, mxl, is, xt) in ''C'')  is  []"
using EP_wf
by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)

lemma [simp]:
  "T Ts mxs mxl is. (xt. EP  ''C'' sees ''M'': TsT = (mxs, mxl, is, xt) in ''C'')  
  Suc 0 < length is"
using EP_wf
by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)

lemma C_sees_M_in_EP [simp]:
  "EP  ''C'' sees ''M'': []Void = (1, 0, [Push Unit, Return], []) in ''C''"
apply (auto simp: Method_def EP_def)
apply (rule_tac x="Map.empty(''M''  (([], Void, 1, 0, [Push Unit, Return], []),''C''))" in exI)
apply auto
apply (rule Methods.intros(2))
   apply (fastforce simp: class_def)
  apply clarsimp
 apply (rule Methods.intros(1))
  apply (fastforce simp: class_def SystemClasses_def ObjectC_def)
 apply fastforce
by fastforce

lemma instrs_of_EP_C_M [simp]:
  "instrs_of EP ''C'' ''M'' = [Push Unit, Return]"
  using C_sees_M_in_EP
apply (simp add: method_def)
apply (rule theI2)
  apply fastforce
 apply (clarsimp dest!: method_in_EP_is_M)
by (clarsimp dest!: method_in_EP_is_M)

(*
lemma valid_cs_seesM_D: 
  "valid_callstack (P, C0, Main) ((C, M, pc)#cs) ⟹
  ∃Ts T mxs mxl is xt. (Pwf) ⊢ C sees M:Ts→T=(mxs, mxl, is, xt) in C ∧ pc < length is"
  by (cases cs, fastforce+)
*)

lemma valid_node_in_EP_D:
  "valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') n
   n  {(_Entry_), (_ [(''C'', ''M'', 0)],None _), (_ [(''C'', ''M'', 1)],None _), (_Exit_)}"
proof -
  assume vn: "valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') n"
  show ?thesis
  proof (cases n)
    case Entry
    thus ?thesis
      by simp
  next
    case [simp]: (Node cs opt)
    show ?thesis
    proof (cases opt)
      case [simp]: None
      from vn
      show ?thesis
        apply (cases cs)
         apply simp
        apply (case_tac list)
         apply clarsimp
         apply (drule method_in_EP_is_M)
         apply clarsimp
        apply clarsimp
        apply (drule method_in_EP_is_M)
        apply clarsimp
        apply (case_tac lista)
         apply clarsimp
         apply (drule method_in_EP_is_M)
         apply clarsimp
         apply (case_tac ba, clarsimp, clarsimp)
        apply clarsimp
        apply (drule method_in_EP_is_M)
        apply clarsimp
        by (case_tac ba, clarsimp, clarsimp)
    next
      case [simp]: (Some f)
      obtain cs'' xf where [simp]: "f = (cs'', xf)"
        by (cases f, fastforce)
      from vn
      show ?thesis
        apply (cases cs)
         apply clarsimp
         apply (erule JVM_CFG.cases, clarsimp+)
        apply (case_tac list)
         apply clarsimp
         apply (frule method_in_EP_is_M)
         apply (case_tac b)
          apply (erule JVM_CFG.cases, clarsimp+)
         apply (erule JVM_CFG.cases, clarsimp+)
        apply (frule method_in_EP_is_M)
        apply (case_tac b)
         apply (erule JVM_CFG.cases, clarsimp+)
        by (erule JVM_CFG.cases, clarsimp+)
    qed
  qed
qed

lemma EP_C_M_0_valid [simp]:
  "JVM_CFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') 
    (_ [(''C'', ''M'', 0)],None _)"
proof -
  have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
    ((_Entry_), (λs. True), (_ [(''C'', ''M'', 0)],None _))"
    apply (auto simp: Phi_EP_def)
    by rule auto
  thus ?thesis
    by (fastforce simp: JVM_CFG_Interpret.valid_node_def)
qed

lemma EP_C_M_Suc_0_valid [simp]:
  "JVM_CFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') 
    (_ [(''C'', ''M'', Suc 0)],None _)"
proof -
  have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
    ((_ [(''C'', ''M'', Suc 0)],None _), id, (_Exit_))"
    apply (auto simp: Phi_EP_def)
    by rule auto
  thus ?thesis
    by (fastforce simp: JVM_CFG_Interpret.valid_node_def)
qed


definition
  "cfg_wf_prog =
    {P. (n. valid_node P n 
         (as. JVM_CFG_Interpret.path P (_Entry_) as n) 
         (as. JVM_CFG_Interpret.path P n as (_Exit_)))}"

typedef cfg_wf_prog = cfg_wf_prog
  unfolding cfg_wf_prog_def
proof
  let ?prog = "((Abs_wf_jvmprog (EP, Phi_EP)), ''C'', ''M'')"
  let ?edge0 = "((_Entry_), (λs. False), (_Exit_))"
  let ?edge1 = "((_Entry_), (λs. True), (_ [(''C'', ''M'', 0)],None _))"
  let ?edge2 = "((_ [(''C'', ''M'', 0)],None _),
                 (λ(h, stk, loc). (h, stk((0, 0) := Unit), loc)),
                 (_ [(''C'', ''M'', 1)],None _))"
  let ?edge3 = "((_ [(''C'', ''M'', 1)],None _), id, (_Exit_))"
  show "?prog  {P. n. valid_node P n 
                 (as. CFG.path sourcenode targetnode (valid_edge P) (_Entry_) as n) 
                 (as. CFG.path sourcenode targetnode (valid_edge P) n as (_Exit_))}"
  proof (auto dest!: valid_node_in_EP_D)
    have "JVM_CFG_Interpret.path ?prog (_Entry_) [] (_Entry_)"
      by (simp add: JVM_CFG_Interpret.path.empty_path)
    thus "as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_Entry_)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge0] (_Exit_)"
      by rule (auto intro: JCFG_EntryExit JVM_CFG_Interpret.path.empty_path)
    thus "as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_Exit_)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge1] (_ [(''C'', ''M'', 0)],None _)"
      by rule (auto intro: JCFG_EntryStart simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
    thus "as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_ [(''C'', ''M'', 0)],None _)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', 0)],None _) [?edge2, ?edge3] (_Exit_)"
      apply rule
         apply rule
            apply (auto simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
       apply (rule JCFG_ReturnExit, auto)
      by (rule JCFG_Straight_NoExc, auto simp: Phi_EP_def)
    thus "as. JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', 0)],None _) as (_Exit_)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge1, ?edge2] (_ [(''C'', ''M'', 1)],None _)"
      apply rule
         apply rule
            apply (auto simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
       apply (rule JCFG_Straight_NoExc, auto simp: Phi_EP_def)
      by (rule JCFG_EntryStart, auto)
    thus "as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_ [(''C'', ''M'', Suc 0)],None _)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', Suc 0)],None _) [?edge3] (_Exit_)"
      apply rule
         apply (auto simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
      by (rule JCFG_ReturnExit, auto)
    thus "as. JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', Suc 0)],None _) as (_Exit_)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge0] (_Exit_)"
      by rule (auto intro: JCFG_EntryExit JVM_CFG_Interpret.path.empty_path)
    thus "as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_Exit_)"
      by fastforce
  next
    have "JVM_CFG_Interpret.path ?prog (_Exit_) [] (_Exit_)"
      by (simp add: JVM_CFG_Interpret.path.empty_path)
    thus "as. JVM_CFG_Interpret.path ?prog (_Exit_) as (_Exit_)"
      by fastforce
  qed
qed


abbreviation lift_to_cfg_wf_prog :: "(jvmprog  'a)  (cfg_wf_prog  'a)"
  ("_CFG")
  where "fCFG  (λP. f (Rep_cfg_wf_prog P))"

section ‹Interpretation of the Postdomination› locale›

interpretation JVM_CFG_Postdomination:
  Postdomination "sourcenode" "targetnode" "kind" "valid_edgeCFG prog" "Entry" "(_Exit_)"
  for prog
proof(unfold_locales)
  fix n
  assume vn: "CFG.valid_node sourcenode targetnode (valid_edgeCFG prog) n" 
  have prog_is_cfg_wf_prog: "Rep_cfg_wf_prog prog  cfg_wf_prog"
    by (rule Rep_cfg_wf_prog)
  obtain P C0 Main where [simp]: "Rep_cfg_wf_prog prog = (P,C0,Main)"
    by (cases "Rep_cfg_wf_prog prog", fastforce)
  from prog_is_cfg_wf_prog have "(P, C0, Main)  cfg_wf_prog"
    by simp
  hence "valid_node (P, C0, Main) n 
    (as. CFG.path sourcenode targetnode (valid_edge (P, C0, Main)) (_Entry_) as n)"
    by (fastforce simp: cfg_wf_prog_def)
  moreover from vn have "valid_node (P, C0, Main) n"
    by (auto simp: JVM_CFG_Interpret.valid_node_def)
  ultimately
  show "as. CFG.path sourcenode targetnode (valid_edgeCFG prog) (_Entry_) as n"
    by simp
next
  fix n
  assume vn: "CFG.valid_node sourcenode targetnode (valid_edgeCFG prog) n" 
  have prog_is_cfg_wf_prog: "Rep_cfg_wf_prog prog  cfg_wf_prog"
    by (rule Rep_cfg_wf_prog)
  obtain P C0 Main where [simp]: "Rep_cfg_wf_prog prog = (P,C0,Main)"
    by (cases "Rep_cfg_wf_prog prog", fastforce)
  from prog_is_cfg_wf_prog have "(P, C0, Main)  cfg_wf_prog"
    by simp
  hence "valid_node (P, C0, Main) n 
    (as. CFG.path sourcenode targetnode (valid_edge (P, C0, Main)) n as (_Exit_))"
    by (fastforce simp: cfg_wf_prog_def)
  moreover from vn have "valid_node (P, C0, Main) n"
    by (auto simp: JVM_CFG_Interpret.valid_node_def)
  ultimately
  show "as. CFG.path sourcenode targetnode (valid_edgeCFG prog) n as (_Exit_)"
    by simp
qed


section ‹Interpretation of the StrongPostdomination› locale›

subsection ‹Some helpfull lemmas›

lemma find_handler_for_tl_eq:
  "find_handler_for P Exc cs = (C,M,pcx)#cs'  cs'' pc. cs = cs'' @ [(C,M,pc)] @ cs'"
  by (induct cs, auto)

lemma valid_callstack_tl:
  "valid_callstack prog ((C,M,pc)#cs)  valid_callstack prog cs"
  by (cases prog, cases cs, auto)

lemma find_handler_Throw_Invoke_pc_in_range:
  "cs = (C',M',pc')#cs'; valid_callstack (P,C0,Main) cs;
  instrs_of (Pwf) C' M' ! pc' = Throw  (M'' n''. instrs_of (Pwf) C' M' ! pc' = Invoke M'' n'');
  find_handler_for P Exc cs = (C,M,pc)#cs'' 
   pc < length (instrs_of (Pwf) C M)"
proof (induct cs arbitrary: C' M' pc' cs')
  case Nil
  thus ?case by simp
next
  case (Cons a cs)
  hence [simp]: "a = (C',M',pc')" and [simp]: "cs = cs'" by simp_all
  note IH = C' M' pc' cs'.
           cs = (C', M', pc') # cs'; valid_callstack (P, C0, Main) cs;
            instrs_of Pwf C' M' ! pc' = Throw 
            (M'' n''. instrs_of Pwf C' M' ! pc' = Invoke M'' n'');
            find_handler_for P Exc cs = (C, M, pc) # cs''
            pc < length (instrs_of Pwf C M)
  note throw = ‹instrs_of Pwf C' M' ! pc' = Throw  (M'' n''. instrs_of Pwf C' M' ! pc' = Invoke M'' n'')
  note fhf = ‹find_handler_for P Exc (a # cs) = (C, M, pc) # cs''
  note v_cs_a_cs = ‹valid_callstack (P, C0, Main) (a # cs)
  show ?case
  proof (cases "match_ex_table (Pwf) Exc pc' (ex_table_of (Pwf) C' M')")
    case None
    with fhf have fhf_tl: "find_handler_for P Exc cs = (C,M,pc)#cs''"
      by simp
    from v_cs_a_cs have "valid_callstack (P, C0, Main) cs"
      by (auto dest: valid_callstack_tl)
    from v_cs_a_cs
    have "cs  []  (let (C,M,pc) = hd cs in n. instrs_of (Pwf) C M ! pc = Invoke M' n)"
      by (cases cs', auto)
    with IH None fhf_tl ‹valid_callstack (P, C0, Main) cs
    show ?thesis
      by (cases cs) fastforce+
  next
    case (Some xte)
    with fhf have [simp]: "C' = C" and [simp]: "M' = M" by simp_all
    from v_cs_a_cs fhf Some
    obtain Ts T mxs mxl "is" xt where wt_class:
      "(Pwf)  C sees M: TsT = (mxs, mxl, is, xt) in C 
      pc' < length is  (PΦ) C M ! pc'  None"
      by (cases cs) fastforce+
    with wf_jvmprog_is_wf [of P]
    have wt_instr:"(Pwf),T,mxs,length is,xt  is ! pc',pc' :: (PΦ) C M"
      by (fastforce dest!: wt_jvm_prog_impl_wt_instr)
    from Some fhf obtain f t D d where "(f,t,D,pc,d) set (ex_table_of (Pwf) C M) 
      matches_ex_entry (Pwf) Exc pc' (f,t,D,pc,d)"
      by (cases xte, fastforce dest: match_ex_table_SomeD)
    with wt_instr throw wt_class
    show ?thesis
      by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
  qed
qed


subsection ‹Every node has only finitely many successors›

lemma successor_set_finite:
  "JVM_CFG_Interpret.valid_node prog n 
   finite {n'. a'. valid_edge prog a'  sourcenode a' = n 
                      targetnode a' = n'}"
proof -
  assume valid_node: "JVM_CFG_Interpret.valid_node prog n"
  obtain P C0 Main where [simp]: "prog = (P, C0, Main)"
    by (cases prog, fastforce)
  note P_wf = wf_jvmprog_is_wf [of P]
  show ?thesis
  proof (cases n)
    case Entry
    thus ?thesis
      by (rule_tac B="{(_Exit_), (_ [(C0, Main, 0)],None _)}" in finite_subset,
        auto dest: JVMCFG_EntryD)
  next
    case [simp]: (Node cs x)
    show ?thesis
    proof (cases cs)
      case Nil
      thus ?thesis
        by (rule_tac B="{}" in finite_subset,
          auto elim: JVM_CFG.cases)
    next
      case [simp]: (Cons a cs')
      obtain C M pc where [simp]: "a = (C,M,pc)" by (cases a, fastforce)
      have finite_classes: "finite {C. is_class (Pwf) C}"
        by (rule finite_is_class)
      from valid_node have "is_class (Pwf) C"
        apply (auto simp: JVM_CFG_Interpret.valid_node_def)
         apply (cases x, auto)
          apply (cases cs', auto dest!: sees_method_is_class)
         apply (cases cs', auto dest!: sees_method_is_class)
        apply (cases cs', auto dest!: sees_method_is_class)
         apply (cases x, auto dest!: sees_method_is_class)
        by (cases x, auto dest!: sees_method_is_class)
      show ?thesis
      proof (cases "instrs_of (Pwf) C M ! pc")
        case (Load nat)
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',x _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case (Store nat)
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',x _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case (Push val)
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',x _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case (New C')
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,pc)#cs',((C,M,Suc pc)#cs',False) _),
            (_ (C,M,pc)#cs',(find_handler_for P OutOfMemory ((C,M,pc)#cs'),True) _),
            (_ fst(the(x)),None _)}" in finite_subset)
           apply (rule subsetI)
           apply (clarsimp simp del: find_handler_for.simps)
           by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
      next
        case (Getfield Fd C')
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,pc)#cs',((C,M,Suc pc)#cs',False) _),
            (_ (C,M,pc)#cs',(find_handler_for P NullPointer ((C,M,pc)#cs'),True) _),
            (_ fst(the(x)),None _)}" in finite_subset)
           apply (rule subsetI)
           apply (clarsimp simp del: find_handler_for.simps)
           by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
      next
        case (Putfield Fd C')
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,pc)#cs',((C,M,Suc pc)#cs',False) _),
            (_ (C,M,pc)#cs',(find_handler_for P NullPointer ((C,M,pc)#cs'),True) _),
            (_ fst(the(x)),None _)}" in finite_subset)
           apply (rule subsetI)
           apply (clarsimp simp del: find_handler_for.simps)
           by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
      next
        case (Checkcast C')
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _),
            (_ (C,M,pc)#cs',(find_handler_for P ClassCast ((C,M,pc)#cs'),True) _),
            (_ fst(the(x)),None _)}" in finite_subset)
           apply (rule subsetI)
           apply (clarsimp simp del: find_handler_for.simps)
           by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
      next
        case (Invoke M' n')
        with finite_classes valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="
            {n'. (D. is_class (Pwf) D  n' = (_ (C,M,pc)#cs',((D,M',0)#(C,M,pc)#cs',False) _))}
             {(_ (C,M,pc)#cs',(find_handler_for P NullPointer ((C,M,pc)#cs'),True) _),
               (_ fst(the(x)),None _)}"
            in finite_subset)
           apply (rule subsetI)
           apply (clarsimp simp del: find_handler_for.simps)
           apply (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
          apply (clarsimp simp del: find_handler_for.simps)
          apply (drule sees_method_is_class)
          by (clarsimp simp del: find_handler_for.simps)
      next
        case Return
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="
            {(_ (fst(hd(cs')),fst(snd(hd(cs'))),Suc(snd(snd(hd(cs')))))#(tl cs'),None _),
             (_Exit_)}" in finite_subset)
           apply (rule subsetI)
           apply (clarsimp simp del: find_handler_for.simps)
           by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
      next
        case Pop
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case IAdd
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case (Goto i)
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,nat (int pc + i))#cs',None _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case CmpEq
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case (IfFalse i)
        with valid_node
        show ?thesis
          apply auto
          apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _),
            (_ (C,M,nat (int pc + i))#cs',None _)}" in finite_subset)
           by (auto elim: JVM_CFG.cases)
      next
        case Throw
        have "finite {(l,pc'). l < Suc (length cs') 
          pc' < (i(length cs'). (length (instrs_of (Pwf) (fst (((C, M, pc) # cs') ! i))
          (fst (snd (((C, M, pc) # cs') ! i))))))}"
          (is "finite ?f1")
          by (auto intro: finite_cartesian_product bounded_nat_set_is_finite)
        hence f_1: "finite {(l,pc'). l < length ((C, M, pc) # cs') 
            pc' < length (instrs_of (Pwf) (fst(((C,M,pc)#cs')!l)) (fst(snd(((C,M,pc)#cs')!l))))}"
          apply (rule_tac B="?f1" in finite_subset)
           apply clarsimp
           apply (rule less_le_trans)
            defer
            apply (rule_tac A="{a}" in sum_mono2)
              by simp_all
        from valid_node Throw
        show ?thesis
          apply auto
          apply (rule_tac B="
            {n'. Cx Mx pc' h cs'' pcx. (C,M,pc)#cs' = cs''@[(Cx,Mx,pcx)]@h 
              pc' < length (instrs_of (Pwf) Cx Mx) 
              n' = (_ (C,M,pc)#cs',((Cx,Mx,pc')#h,True) _)}
             {(_ fst(the(x)),None _), (_Exit_), (_ (C,M,pc)#cs',([],True) _)}"
            in finite_subset)
           apply (rule subsetI)
           apply clarsimp
           apply (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
           apply (clarsimp simp del: find_handler_for.simps)
           apply (case_tac "find_handler_for P Exc ((C,M,pc)#cs')", simp)
           apply (clarsimp simp del: find_handler_for.simps)
           apply (erule impE)
            apply (case_tac "list", fastforce, fastforce)
           apply (frule find_handler_for_tl_eq)
           apply (clarsimp simp del: find_handler_for.simps)
           apply (erule_tac x="list" in allE)
           apply (clarsimp simp del: find_handler_for.simps)
          apply (subgoal_tac 
            "finite (
              (λ(Cx,Mx,pc',h,cs'',pcx).  (_ (C, M, pc) # cs',((Cx, Mx, pc') # h, True) _)) `
              {(Cx,Mx,pc',h,cs'',pcx). (C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h 
                pc' < length (instrs_of Pwf Cx Mx)})")
           apply (case_tac "((λ(Cx, Mx, pc', h, cs'', pcx).
             (_ (C, M, pc) # cs',((Cx, Mx, pc') # h, True) _)) `
             {(Cx, Mx, pc', h, cs'', pcx).
               (C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h 
               pc' < length (instrs_of (Pwf) Cx Mx)}) =
             {n'. Cx Mx pc' h.
                (cs'' pcx. (C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h) 
                pc' < length (instrs_of (Pwf) Cx Mx) 
                n' = (_ (C, M, pc) # cs',((Cx, Mx, pc') # h, True) _)}")
            apply clarsimp
           apply (erule notE)
           apply (rule equalityI)
            apply clarsimp
           apply clarsimp
           apply (rule_tac x="(Cx,Mx,pc',h,cs'',pcx)" in image_eqI)
            apply clarsimp
           apply clarsimp
          apply (rule finite_imageI)
          apply (subgoal_tac "finite (
            (λ(l, pc'). (fst(((C, M, pc)#cs') ! l),
                         fst(snd(((C, M, pc)#cs') ! l)),
                         pc',
                         drop l cs',
                         take l ((C, M, pc)#cs'),
                         snd(snd(((C, M, pc)#cs') ! l))
                        )
            ) ` {(l, pc'). l < length ((C,M,pc)#cs') 
                           pc' < length (instrs_of (Pwf) (fst(((C, M, pc)#cs') ! l))
                                                        (fst(snd(((C, M, pc)#cs') ! l))))})")
           apply (case_tac "((λ(l, pc').
             (fst (((C, M, pc) # cs') ! l),
              fst (snd (((C, M, pc) # cs') ! l)),
              pc',
              drop l cs',
              take l ((C, M, pc) # cs'),
              snd (snd (((C, M, pc) # cs') ! l))
             )) ` {(l, pc'). l < length ((C,M,pc)#cs') 
                             pc' < length (instrs_of (Pwf) (fst (((C, M, pc) # cs') ! l))
                                                          (fst (snd (((C, M, pc) # cs') ! l))))})
             = {(Cx, Mx, pc', h, cs'', pcx).
                (C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h 
                pc' < length (instrs_of (Pwf) Cx Mx)}")
            apply clarsimp
           apply (erule notE)
           apply (rule equalityI)
            apply clarsimp
            apply (rule id_take_nth_drop [of _ "(C,M,pc)#cs'", simplified])
            apply simp
           apply clarsimp
           apply (rule_tac x="(length ad,ab)" in image_eqI)
            apply clarsimp
            apply (case_tac ad, clarsimp, clarsimp)
           apply clarsimp
           apply (case_tac ad, clarsimp, clarsimp)
          apply (rule finite_imageI)
          by (rule f_1)
      qed
    qed
  qed
qed

subsection ‹Interpretation of the locale›

interpretation JVM_CFG_StrongPostdomination:
  StrongPostdomination "sourcenode" "targetnode" "kind" "valid_edgeCFG prog" "Entry" "(_Exit_)"
  for prog
proof(unfold_locales)
  fix n
  assume vn: "CFG.valid_node sourcenode targetnode (valid_edgeCFG prog) n"
  thus "finite {n'. a'. valid_edgeCFG prog a'  sourcenode a' = n  targetnode a' = n'}"
    by (rule successor_set_finite)
qed

end

Theory JVMCFG_wf

theory JVMCFG_wf imports JVMInterpretation "../Basic/CFGExit_wf" begin

section ‹Instantiation of the CFG_wf› locale›

subsection ‹Variables and Values›

datatype jinja_var = HeapVar "addr" | Stk "nat" "nat" | Loc "nat" "nat"
datatype jinja_val = Object "obj option" | Primitive "val"

fun state_val :: "state  jinja_var  jinja_val"
where
  "state_val (h, stk, loc) (HeapVar a) = Object (h a)"
| "state_val (h, stk, loc) (Stk cd idx) = Primitive (stk (cd, idx))"
| "state_val (h, stk, loc) (Loc cd idx) = Primitive (loc (cd, idx))"


subsection ‹The Def› and Use› sets›

inductive_set Def :: "wf_jvmprog  j_node  jinja_var set"
  for P :: "wf_jvmprog"
  and n :: "j_node"
where
  Def_Load:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Load idx;
  cd = length cs;
  i = stkLength P C M pc
   Stk cd i  Def P n"

| Def_Store:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Store idx;
  cd = length cs 
   Loc cd idx  Def P n"

| Def_Push:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Push v;
  cd = length cs;
  i = stkLength P C M pc 
   Stk cd i  Def P n"

| Def_New_Normal_Stk:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = New Cl;
  cd = length cs;
  i = stkLength P C M pc 
   Stk cd i  Def P n"

| Def_New_Normal_Heap:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = New Cl 
   HeapVar a  Def P n"

| Def_Exc_Stk:
  " n = (_ (C, M, pc)#cs,(cs',True) _);
  cs'  [];
  cd = length cs' - 1;
  (C',M',pc') = hd cs';
  i = stkLength P C' M' pc' - 1
   Stk cd i  Def P n"

| Def_Getfield_Stk:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Getfield Fd Cl;
  cd = length cs;
  i = stkLength P C M pc - 1 
   Stk cd i  Def P n"

| Def_Putfield_Heap:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Putfield Fd Cl 
   HeapVar a  Def P n"

| Def_Invoke_Loc:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Invoke M' n';
  cs'  [];
  hd cs' = (C',M',0);
  i < locLength P C' M' 0;
  cd = Suc (length cs) 
   Loc cd i  Def P n"

| Def_Return_Stk:
  " n = (_ (C, M, pc)#(D,M',pc')#cs,None _);
  instrs_of (Pwf) C M ! pc = Return;
  cd = length cs;
  i = stkLength P D M' (Suc pc') - 1 
   Stk cd i  Def P n"

| Def_IAdd_Stk:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = IAdd;
  cd = length cs;
  i = stkLength P C M pc - 2 
   Stk cd i  Def P n"

| Def_CmpEq_Stk:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = CmpEq;
  cd = length cs;
  i = stkLength P C M pc - 2 
   Stk cd i  Def P n"

inductive_set Use :: "wf_jvmprog  j_node  jinja_var set"
  for P :: "wf_jvmprog"
  and n :: "j_node"
where
  Use_Load:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Load idx;
  cd = length cs 
   (Loc cd idx)  Use P n"

| Use_Store:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Store idx;
  cd = length cs;
  Suc i = (stkLength P C M pc) 
   (Stk cd i)  Use P n"

| Use_New:
  " n = (_ (C, M, pc)#cs,x _);
  x = None  x = (cs',False);
  instrs_of (Pwf) C M ! pc = New Cl 
   HeapVar a  Use P n"

| Use_Getfield_Stk:
  " n = (_ (C, M, pc)#cs,x _);
  x = None  x = (cs',False);
  instrs_of (Pwf) C M ! pc = Getfield Fd Cl;
  cd = length cs;
  Suc i = stkLength P C M pc 
   Stk cd i  Use P n"

| Use_Getfield_Heap:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Getfield Fd Cl 
   HeapVar a  Use P n"

| Use_Putfield_Stk_Pred:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Putfield Fd Cl;
  cd = length cs;
  i = stkLength P C M pc - 2 
   Stk cd i  Use P n"

| Use_Putfield_Stk_Update:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Putfield Fd Cl;
  cd = length cs;
  i = stkLength P C M pc - 2  i = stkLength P C M pc - 1 
   Stk cd i  Use P n"

| Use_Putfield_Heap:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Putfield Fd Cl 
   HeapVar a  Use P n"

| Use_Checkcast_Stk:
  " n = (_ (C, M, pc)#cs,x _);
  x = None  x = (cs',False);
  instrs_of (Pwf) C M ! pc = Checkcast Cl;
  cd = length cs;
  i = stkLength P C M pc - Suc 0 
   Stk cd i  Use P n"

| Use_Checkcast_Heap:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Checkcast Cl 
   HeapVar a  Use P n"

| Use_Invoke_Stk_Pred:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Invoke M' n';
  cd = length cs;
  i = stkLength P C M pc - Suc n' 
   Stk cd i  Use P n"

| Use_Invoke_Heap_Pred:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = Invoke M' n' 
   HeapVar a  Use P n"

| Use_Invoke_Stk_Update:
  " n = (_ (C, M, pc)#cs,(cs',False) _);
  instrs_of (Pwf) C M ! pc = Invoke M' n';
  cd = length cs;
  i < stkLength P C M pc;
  i  stkLength P C M pc - Suc n' 
   Stk cd i  Use P n"

| Use_Return_Stk:
  " n = (_ (C, M, pc)#(D,M',pc')#cs,None _);
  instrs_of (Pwf) C M ! pc = Return;
  cd = Suc (length cs);
  i = stkLength P C M pc - 1 
   Stk cd i  Use P n"

| Use_IAdd_Stk:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = IAdd;
  cd = length cs;
  i = stkLength P C M pc - 1  i = stkLength P C M pc - 2 
   Stk cd i  Use P n"

| Use_IfFalse_Stk:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = (IfFalse b);
  cd = length cs;
  i = stkLength P C M pc - 1 
   Stk cd i  Use P n"

| Use_CmpEq_Stk:
  " n = (_ (C, M, pc)#cs,None _);
  instrs_of (Pwf) C M ! pc = CmpEq;
  cd = length cs;
  i = stkLength P C M pc - 1  i = stkLength P C M pc - 2 
   Stk cd i  Use P n"

| Use_Throw_Stk:
  " n = (_ (C, M, pc)#cs,x _);
  x = None  x = (cs',True);
  instrs_of (Pwf) C M ! pc = Throw;
  cd = length cs;
  i = stkLength P C M pc - 1 
   Stk cd i  Use P n"

| Use_Throw_Heap:
  " n = (_ (C, M, pc)#cs,x _);
  x = None  x = (cs',True);
  instrs_of (Pwf) C M ! pc = Throw 
   HeapVar a  Use P n"

declare correct_state_def [simp del]

lemma edge_transfer_uses_only_Use:
  "valid_edge (P,C0,Main) a; V  Use P (sourcenode a). state_val s V = state_val s' V
   V  Def P (sourcenode a). state_val (BasicDefs.transfer (kind a) s) V =
                                  state_val (BasicDefs.transfer (kind a) s') V"
proof
  fix V
  assume ve: "valid_edge (P, C0, Main) a"
    and use_eq: "VUse P (sourcenode a). state_val s V = state_val s' V"
    and v_in_def: "V  Def P (sourcenode a)"
  obtain h stk loc where [simp]: "s = (h,stk,loc)" by (cases s, fastforce)
  obtain h' stk' loc' where [simp]: "s' = (h',stk',loc')" by (cases s', fastforce)
  note P_wf = wf_jvmprog_is_wf [of P]
  from ve
  have ex_edge: "(P,C0,Main)  (sourcenode a)-kind a(targetnode a)"
    and vn: "valid_node (P,C0,Main) (sourcenode a)"
    by simp_all
  show "state_val (transfer (kind a) s) V = state_val (transfer (kind a) s') V"
  proof (cases "sourcenode a")
    case [simp]: (Node cs x)
    from vn ex_edge have "cs  []"
      by (cases x, auto elim: JVM_CFG.cases)
    then obtain C M pc cs' where [simp]: "cs = (C, M, pc)#cs'" by (cases cs, fastforce+)
    with vn obtain ST LT where wt: "((PΦ) C M ! pc) = (ST,LT)"
      by (cases cs', (cases x, auto)+)
    show ?thesis
    proof (cases "instrs_of (Pwf) C M ! pc")
      case [simp]: (Load n)
      from ex_edge have [simp]: "x = None"
        by (auto elim!: JVM_CFG.cases)
      hence "Loc (length cs') n  Use P (sourcenode a)"
        by (auto intro!: Use_Load)
      with use_eq have "state_val s (Loc (length cs') n) = state_val s' (Loc (length cs') n)"
        by (simp del: state_val.simps)
      with v_in_def ex_edge show ?thesis
        by (auto elim!: Def.cases
                  elim: JVM_CFG.cases
                  simp: split_beta)
    next
      case [simp]: (Store n)
      from ex_edge have [simp]:"x = None"
        by (auto elim!: JVM_CFG.cases)
      have "ST  []"
      proof -
        from vn
        obtain Ts T mxs mxl "is" xt
          where C_sees_M: "Pwf  C sees M: TsT = (mxs, mxl, is, xt) in C"
          by (cases cs', auto)
        with vn
        have "pc < length is"
          by (cases cs', auto dest: sees_method_fun)
        from P_wf C_sees_M
        have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
          by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
        with Store C_sees_M wt pc < length is
        show ?thesis
          by (fastforce simp: wt_method_def)
      qed
      then obtain ST1 STr where [simp]: "ST = ST1#STr"
        by (cases ST, fastforce+)
      from wt
        have "Stk (length cs') (length ST - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use_src")
          by -(rule Use_Store, fastforce+)
      with use_eq have "state_val s ?stk_top = state_val s' ?stk_top"
        by (simp del: state_val.simps)
      with v_in_def ex_edge wt show ?thesis
        by (auto elim!: Def.cases
                  elim: JVM_CFG.cases
                  simp: split_beta)
    next
      case [simp]: (Push val)
      from ex_edge have "x = None"
        by (auto elim!: JVM_CFG.cases)
      with v_in_def ex_edge show ?thesis
        by (auto elim!: Def.cases
                  elim: JVM_CFG.cases)
    next
      case [simp]: (New Cl)
      show ?thesis
      proof (cases x)
        case None
        with v_in_def have False
          by (auto elim: Def.cases)
        thus ?thesis by simp
      next
        case (Some x')
        then obtain cs'' xf where [simp]: "x = (cs'',xf)"
          by (cases x', fastforce)
        have "¬ xf  (addr. HeapVar addr  Use P (sourcenode a))"
          by (fastforce intro: Use_New)
        with use_eq
        have "¬ xf  (addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr))"
          by (simp del: state_val.simps)
        hence "¬ xf  h = h'"
          by (auto intro: ext)
        with v_in_def ex_edge show ?thesis
          by (auto elim!: Def.cases
                    elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (Getfield Fd Cl)
      show ?thesis
      proof (cases x)
        case None
        with v_in_def have False
          by (auto elim: Def.cases)
        thus ?thesis by simp
      next
        case (Some x')
        then obtain cs'' xf where [simp]: "x = (cs'',xf)"
          by (cases x', fastforce)
        have "ST  []"
        proof -
          from vn obtain T Ts mxs mxl "is" xt
            where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
            by (cases cs', auto)
          with vn
          have "pc < length is"
            by (cases cs', auto dest: sees_method_fun)
          from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
            by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
          with Getfield sees_M wt pc < length is show ?thesis
            by (fastforce simp: wt_method_def)
        qed
        then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce)
        from wt
        have "¬ xf  (Stk (length cs') (length ST - 1)  Use P (sourcenode a))"
          (is "?xf  ?stk_top  ?Use_src")
          by (auto intro!: Use_Getfield_Stk)
        with use_eq 
        have stk_top_eq: "¬ xf  state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        have "¬ xf  (addr. HeapVar addr  Use P (sourcenode a))"
          by (auto intro!: Use_Getfield_Heap)
        with use_eq
        have "¬ xf  (addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr))"
          by (simp del: state_val.simps)
        hence "¬ xf  h = h'"
          by (auto intro: ext)
        with ex_edge v_in_def stk_top_eq wt
        show ?thesis
          by (auto elim!: Def.cases
                    elim: JVM_CFG.cases
                    simp: split_beta)
      qed
    next
      case [simp]: (Putfield Fd Cl)
      show ?thesis
      proof (cases x)
        case None
        with v_in_def have False
          by (auto elim: Def.cases)
        thus ?thesis by simp
      next
        case (Some x')
        then obtain cs'' xf where [simp]: "x = (cs'',xf)" 
          by (cases x', fastforce)
        have "length ST > 1"
        proof -
          from vn obtain T Ts mxs mxl "is" xt
            where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
            by (cases cs', auto)
          with vn
          have "pc < length is"
            by (cases cs', auto dest: sees_method_fun)
          from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
            by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
          with Putfield sees_M pc < length is wt show ?thesis
            by (fastforce simp: wt_method_def)
        qed
        then obtain ST1 STr' where "ST = ST1#STr'  length STr' > 0"
          by (cases ST, fastforce+)
        then obtain ST2 STr where [simp]: "ST = ST1#ST2#STr"
          by (cases STr', fastforce+)
        from wt
        have "¬ xf  (Stk (length cs') (length ST - 1)  Use P (sourcenode a))"
          (is "?xf  ?stk_top  ?Use_src")
          by (fastforce intro: Use_Putfield_Stk_Update)
        with use_eq have stk_top:"(¬ xf)  state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        from wt
        have "¬ xf  (Stk (length cs') (length ST - 2)  Use P (sourcenode a))"
          (is "?xf  ?stk_nxt  ?Use_src")
          by (fastforce intro: Use_Putfield_Stk_Update)
        with use_eq
        have stk_nxt:"(¬ xf)  state_val s ?stk_nxt = state_val s' ?stk_nxt"
          by (simp del: state_val.simps)
        have "¬ xf  (addr. HeapVar addr  Use P (sourcenode a))"
          by (fastforce intro: Use_Putfield_Heap)
        with use_eq
        have "¬ xf  (addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr))"
          by (simp del: state_val.simps)
        hence "¬ xf  h = h'"
          by (auto intro: ext)
        with ex_edge v_in_def stk_top stk_nxt wt show ?thesis
          by (auto elim!: Def.cases
                   elim: JVM_CFG.cases
                   simp: split_beta)
      qed
    next
      case [simp]: (Checkcast Cl)
      show ?thesis
      proof (cases x)
        case None
        with v_in_def have False
          by (auto elim: Def.cases)
        thus ?thesis by simp
      next
        case (Some x')
        with ex_edge obtain cs''
          where "x = (cs'',True)"
          by (auto elim!: JVM_CFG.cases)
        with v_in_def ex_edge show ?thesis
          by (auto elim!: Def.cases
                    elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (Invoke M' n')
      show ?thesis
      proof (cases x)
        case None
        with v_in_def have False
          by (auto elim: Def.cases)
        thus ?thesis by simp
      next
        case (Some x')
        then obtain cs'' xf where [simp]: "x = (cs'',xf)"
          by (cases x', fastforce)
        show ?thesis
        proof (cases xf)
          case True
          with v_in_def ex_edge show ?thesis
            by (auto elim!: Def.cases
                      elim: JVM_CFG.cases)
        next
          case [simp]: False
          have "length ST > n'"
          proof -
            from vn obtain T Ts mxs mxl "is" xt
              where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
              by (cases cs', auto)
            with vn
            have "pc < length is"
              by (cases cs', auto dest: sees_method_fun)
            from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
              by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
            with Invoke sees_M pc < length is wt show ?thesis
              by (fastforce simp: wt_method_def)
          qed
          moreover obtain STn where "STn = take n' ST" by fastforce
          moreover obtain STs where "STs = ST ! n'" by fastforce
          moreover obtain STr where "STr = drop (Suc n') ST" by fastforce
          ultimately have [simp]:" ST = STn@STs#STr  length STn = n'"
            by (auto simp: id_take_nth_drop)
          from wt
          have "i. i  n'  Stk (length cs') (length ST - Suc i)  Use P (sourcenode a)"
            by (fastforce intro: Use_Invoke_Stk_Update)
          with use_eq
          have
            "i. i  n'  state_val s (Stk (length cs') (length ST - Suc i)) =
                           state_val s' (Stk (length cs') (length ST - Suc i))"
            by (simp del: state_val.simps)
          hence stk_eq:
            "i. i  n'  state_val s (Stk (length cs') (i + length STr)) =
                           state_val s' (Stk (length cs') (i + length STr))"
            by (clarsimp, erule_tac x="n' - i" in allE, auto simp: add.commute)
          from ex_edge obtain C'
            where trg: "targetnode a = (_ (C',M',0)#(C, M, pc)#cs',None _)"
            by (fastforce elim: JVM_CFG.cases)
          with ex_edge stk_eq v_in_def wt
          show ?thesis
            by (auto elim!: Def.cases) (erule JVM_CFG.cases, auto simp: split_beta add.commute)
        qed
      qed
    next
      case [simp]: Return
      show ?thesis
      proof (cases x)
        case [simp]: None
        show ?thesis
        proof (cases cs')
          case Nil
          with v_in_def show ?thesis
            by (auto elim!: Def.cases)
        next
          case (Cons aa list)
          then obtain C' M' pc' cs'' where [simp]: "cs' = (C',M',pc')#cs''"
            by (cases aa, fastforce)
          from wt
          have "Stk (length cs') (length ST - 1)  Use P (sourcenode a)"
            by (fastforce intro: Use_Return_Stk)
          with use_eq
          have "state_val s (Stk (length cs') (length ST - 1)) =
                state_val s' (Stk (length cs') (length ST - 1))"
            by (simp del: state_val.simps)
          with v_in_def ex_edge wt show ?thesis
            by (auto elim!: Def.cases
                      elim: JVM_CFG.cases
                      simp: split_beta)
        qed
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case Pop
      with v_in_def ex_edge show ?thesis
        by (auto elim!: Def.cases elim: JVM_CFG.cases)
    next
      case [simp]: IAdd
      show ?thesis
      proof (cases x)
        case [simp]: None
        from wt
        have "Stk (length cs') (length ST - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (auto intro!: Use_IAdd_Stk)
        with use_eq
        have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        from wt
        have "Stk (length cs') (length ST - 2)  Use P (sourcenode a)"
          (is "?stk_snd  ?Use")
          by (auto intro!: Use_IAdd_Stk)
        with use_eq
        have stk_snd:"state_val s ?stk_snd = state_val s' ?stk_snd"
          by (simp del: state_val.simps)
        with v_in_def ex_edge stk_top wt show ?thesis
          by (auto elim!: Def.cases
                    elim: JVM_CFG.cases
                    simp: split_beta)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (IfFalse b)
      show ?thesis
      proof (cases x)
        case [simp]: None
        from wt
        have "Stk (length cs') (length ST - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (auto intro!: Use_IfFalse_Stk)
        with use_eq
        have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        with v_in_def ex_edge wt show ?thesis
          by (auto elim!: Def.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case [simp]: CmpEq
      show ?thesis
      proof (cases x)
        case [simp]: None
        have "Stk (length cs') (stkLength P C M pc - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (auto intro!: Use_CmpEq_Stk)
        with use_eq
        have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        have "Stk (length cs') (stkLength P C M pc - 2)  Use P (sourcenode a)"
          (is "?stk_snd  ?Use")
          by (auto intro!: Use_CmpEq_Stk)
        with use_eq
        have stk_snd:"state_val s ?stk_snd = state_val s' ?stk_snd"
          by (simp del: state_val.simps)
        with v_in_def ex_edge stk_top wt show ?thesis
          by (auto elim!: Def.cases
                    elim: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case (Goto i)
      with ex_edge v_in_def show ?thesis
        by (auto elim!: Def.cases
                  elim: JVM_CFG.cases)
    next
      case [simp]: Throw
      show ?thesis
      proof (cases x)
        case [simp]: None
        have "Stk (length cs') (stkLength P C M pc - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (auto intro!: Use_Throw_Stk)
        with use_eq
        have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        with v_in_def show ?thesis
          by (auto elim!: Def.cases)
      next
        case (Some x')
        then obtain cs'' xf where [simp]: "x = (cs'',xf)"
          by (cases x', fastforce)
        hence "xf  Stk (length cs') (stkLength P C M pc - 1)  Use P (sourcenode a)"
          (is "xf  ?stk_top  ?Use")
          by (fastforce intro: Use_Throw_Stk)
        with use_eq
        have stk_top:"xf  state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        with v_in_def ex_edge show ?thesis
          by (auto elim!: Def.cases
                    elim: JVM_CFG.cases)
      qed
    qed
  next
    case Entry
    with vn v_in_def show ?thesis
      by -(erule Def.cases, auto)
  qed
qed

lemma CFG_edge_Uses_pred_equal:
  " valid_edge (P,C0,Main) a;
  pred (kind a) s; 
  V  Use P (sourcenode a). state_val s V = state_val s' V
   pred (kind a) s'"
proof -
  assume ve: "valid_edge (P,C0,Main) a"
    and pred: "pred (kind a) s"
    and use_eq: "VUse P (sourcenode a). state_val s V = state_val s' V"
  obtain h stk loc where [simp]: "s = (h,stk,loc)" by (cases s, blast)
  obtain h' stk' loc' where [simp]: "s' = (h',stk',loc')" by (cases s', blast)
  from ve
  have vn: "valid_node (P,C0,Main) (sourcenode a)"
    and ex_edge: "(P,C0,Main)  (sourcenode a)-kind a(targetnode a)"
    by simp_all
  note P_wf = wf_jvmprog_is_wf [of P]
  show "pred (kind a) s'"
  proof (cases "sourcenode a")
    case [simp]: (Node cs x)
    from ve have "cs  []"
      by (cases x, auto elim: JVM_CFG.cases)
    then obtain C M pc cs' where [simp]: "cs = (C, M, pc)#cs'" by (cases cs, fastforce+)
    from vn obtain ST LT where wt: "((PΦ) C M ! pc) = (ST,LT)"
      by (cases cs', (cases x, auto)+)
    show ?thesis
    proof (cases "instrs_of (Pwf) C M ! pc")
      case (Load nat)
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case (Store nat)
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case (Push val)
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case [simp]: (New Cl)
      show ?thesis
      proof (cases x)
        case None
        hence "addr. HeapVar addr  Use P (sourcenode a)"
          by (auto intro!: Use_New)
        with use_eq have "addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
          by (simp del: state_val.simps)
        hence "h = h'"
          by (auto intro: ext)
        with ex_edge pred show ?thesis
          by (auto elim!: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (Getfield Fd Cl)
      have "ST  []"
      proof -
        from vn obtain T Ts mxs mxl "is" xt
          where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
          by (cases cs', (cases x, auto)+)
        with vn
        have "pc < length is"
          by (cases cs', (cases x, auto dest: sees_method_fun)+)
        from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
          by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
        with Getfield wt sees_M pc < length is show ?thesis
          by (fastforce simp: wt_method_def)
      qed
      then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases x)
        case [simp]: None
        from wt
        have "Stk (length cs') (length ST - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (fastforce intro: Use_Getfield_Stk)
        with use_eq have "state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        with ex_edge pred wt show ?thesis
          by (auto elim: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (Putfield Fd Cl)
      have "length ST > 1"
      proof -
        from vn obtain T Ts mxs mxl "is" xt
          where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
          by (cases cs', (cases x, auto)+)
        with vn
        have "pc < length is"
          by (cases cs', (cases x, auto dest: sees_method_fun)+)
        from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
          by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
        with Putfield wt sees_M pc < length is show ?thesis
          by (fastforce simp: wt_method_def)
      qed
      then obtain ST1 STr' where "ST = ST1#STr'  STr'  []" by (cases ST, fastforce+)
      then obtain ST2 STr where [simp]: "ST = ST1#ST2#STr" by (cases STr', fastforce+)
      show ?thesis
      proof (cases x)
        case [simp]: None
        with wt
        have "Stk (length cs') (length ST - 2)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (fastforce intro: Use_Putfield_Stk_Pred)
        with use_eq have "state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        with ex_edge pred wt show ?thesis
          by (auto elim: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (Checkcast Cl)
      have "ST  []"
      proof -
        from vn obtain T Ts mxs mxl "is" xt
          where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
          by (cases cs', (cases x, auto)+)
        with vn
        have "pc < length is"
          by (cases cs', (cases x, auto dest: sees_method_fun)+)
        from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
          by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
        with Checkcast wt sees_M pc < length is show ?thesis
          by (fastforce simp: wt_method_def)
      qed
      then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases x)
        case [simp]: None
        from wt
        have "Stk (length cs') (stkLength P C M pc - Suc 0)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (fastforce intro: Use_Checkcast_Stk)
        with use_eq
        have stk_top: "state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        have "addr. HeapVar addr  Use P (sourcenode a)"
          by (fastforce intro: Use_Checkcast_Heap)
        with use_eq
        have "addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
          by (simp del: state_val.simps)
        hence "h = h'"
          by (auto intro: ext)
        with ex_edge stk_top pred wt show ?thesis
          by (auto elim: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case [simp]: (Invoke M' n')
      have "length ST > n'"
      proof -
        from vn obtain T Ts mxs mxl "is" xt
          where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
          by (cases cs', (cases x, auto)+)
        with vn
        have "pc < length is"
          by (cases cs', (cases x, auto dest: sees_method_fun)+)
        from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
          by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
        with Invoke wt sees_M pc < length is show ?thesis
          by (fastforce simp: wt_method_def)
      qed
      moreover obtain STn where "STn = take n' ST" by fastforce
      moreover obtain STs where "STs = ST ! n'" by fastforce
      moreover obtain STr where "STr = drop (Suc n') ST" by fastforce
      ultimately have [simp]:" ST = STn@STs#STr  length STn = n'"
        by (auto simp: id_take_nth_drop)
      show ?thesis
      proof (cases x)
        case [simp]: None
        with wt
        have "Stk (length cs') (stkLength P C M pc - Suc n')  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (fastforce intro: Use_Invoke_Stk_Pred)
        with use_eq
        have stk_top: "state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        have "addr. HeapVar addr  Use P (sourcenode a)"
          by (fastforce intro: Use_Invoke_Heap_Pred)
        with use_eq
        have "addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
          by (simp del: state_val.simps)
        hence "h = h'"
          by (auto intro: ext)
        with ex_edge stk_top pred wt show ?thesis
          by (auto elim: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case Return
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case Pop
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case IAdd
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case [simp]: (IfFalse b)
      show ?thesis
      proof (cases x)
        case [simp]: None
        have "Stk (length cs') (stkLength P C M pc - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (fastforce intro: Use_IfFalse_Stk)
        with use_eq
        have "state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        with ex_edge pred wt show ?thesis
          by (auto elim: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    next
      case CmpEq
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case (Goto i)
      with ex_edge show ?thesis
        by (auto elim: JVM_CFG.cases)
    next
      case [simp]: Throw
      have "ST  []"
      proof -
        from vn obtain T Ts mxs mxl "is" xt
          where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
          by (cases cs', (cases x, auto)+)
        with vn
        have "pc < length is"
          by (cases cs', (cases x, auto dest: sees_method_fun)+)
        from P_wf sees_M have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
          by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
        with Throw wt sees_M pc < length is show ?thesis
          by (fastforce simp: wt_method_def)
      qed
      then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases x)
        case [simp]: None
        from wt
        have "Stk (length cs') (stkLength P C M pc - 1)  Use P (sourcenode a)"
          (is "?stk_top  ?Use")
          by (fastforce intro: Use_Throw_Stk)
        with use_eq
        have stk_top: "state_val s ?stk_top = state_val s' ?stk_top"
          by (simp del: state_val.simps)
        have "addr. HeapVar addr  Use P (sourcenode a)"
          by (fastforce intro: Use_Throw_Heap)
        with use_eq
        have "addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
          by (simp del: state_val.simps)
        hence "h = h'"
          by (auto intro: ext)
        with ex_edge pred stk_top wt show ?thesis
          by (auto elim!: JVM_CFG.cases)
      next
        case (Some x')
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      qed
    qed
  next
    case Entry
    with ex_edge pred show ?thesis
      by (auto elim: JVM_CFG.cases)
  qed
qed


lemma edge_no_Def_equal:
  " valid_edge (P, C0, Main) a;
     V  Def P (sourcenode a) 
   state_val (transfer (kind a) s) V = state_val s V"
proof -
  assume ve:"valid_edge (P, C0, Main) a"
    and v_not_def: "V  Def P (sourcenode a)"
  obtain h stk loc where [simp]: "(s::state) = (h, stk, loc)" by (cases s, blast)
  from ve have vn: "valid_node (P, C0, Main) (sourcenode a)"
    and ex_edge: "(P, C0, Main)  (sourcenode a)-kind a(targetnode a)"
    by simp_all
  show "state_val (transfer (kind a) s) V = state_val s V"
  proof (cases "sourcenode a")
    case [simp]: (Node cs x)
    with ve have "cs  []"
      by (cases x, auto elim: JVM_CFG.cases)
    then obtain C M pc cs' where [simp]: "cs = (C, M, pc)#cs'" by (cases cs, fastforce+)
    with vn obtain ST LT where wt: "((PΦ) C M ! pc) = (ST,LT)"
      by (cases cs', (cases x, auto)+)
    show ?thesis
    proof (cases "instrs_of (Pwf) C M ! pc")
      case [simp]: (Load nat)
      from ex_edge have "x = None"
        by (auto elim: JVM_CFG.cases)
      with v_not_def have "V  Stk (length cs') (stkLength P C M pc)"
        by (auto intro!: Def_Load)
      with ex_edge show ?thesis
        by (auto elim!: JVM_CFG.cases, cases V, auto)
    next
      case [simp]: (Store nat)
      with ex_edge have "x = None"
        by (auto elim: JVM_CFG.cases)
      with v_not_def have "V  Loc (length cs') nat"
        by (auto intro!: Def_Store)
      with ex_edge show ?thesis
        by (auto elim!: JVM_CFG.cases, cases V, auto)
    next
      case [simp]: (Push val)
      with ex_edge have "x = None"
        by (auto elim: JVM_CFG.cases)
      with v_not_def have "V  Stk (length cs') (stkLength P C M pc)"
        by (auto intro!: Def_Push)
      with ex_edge show ?thesis
        by (auto elim!: JVM_CFG.cases, cases V, auto)
    next
      case [simp]: (New Cl)
      show ?thesis
      proof (cases x)
        case None
        with ex_edge show ?thesis
          by (auto elim: JVM_CFG.cases)
      next
        case (Some x')
        then obtain cs'' xf where [simp]: "x = (cs'',xf)"
          by (cases x', fastforce)
        with ex_edge v_not_def show ?thesis
          apply (auto elim!: JVM_CFG.cases)
            apply (cases V, auto intro!: Def_New_Normal_Stk Def_New_Normal_Heap)
           by (cases V, auto intro!: Def_Exc_Stk)+
     qed
   next
     case [simp]: (Getfield F Cl)
     show ?thesis
     proof (cases x)
       case None
       with ex_edge show ?thesis
         by (auto elim: JVM_CFG.cases)
     next
       case (Some x')
       then obtain cs'' xf where [simp]: "x = (cs'',xf)"
         by (cases x', fastforce)
       with ex_edge v_not_def show ?thesis
         apply (auto elim!: JVM_CFG.cases simp: split_beta)
           apply (cases V, auto intro!: Def_Getfield_Stk)
          by (cases V, auto intro!: Def_Exc_Stk)+
     qed
   next
     case [simp]: (Putfield Fd Cl)
     show ?thesis
     proof (cases x)
       case None
       with ex_edge show ?thesis
         by (auto elim: JVM_CFG.cases)
     next
       case (Some x')
       then obtain cs'' xf where [simp]: "x = (cs'',xf)"
         by (cases x', fastforce)
       with ex_edge v_not_def show ?thesis
         apply (auto elim!: JVM_CFG.cases simp: split_beta)
           apply (cases V, auto intro!: Def_Putfield_Heap)
          by (cases V, auto intro!: Def_Exc_Stk)+
     qed
   next
     case [simp]: (Checkcast Cl)
     show ?thesis
     proof (cases x)
       case None
       with ex_edge show ?thesis
         by (auto elim: JVM_CFG.cases)
     next
       case (Some x')
       then obtain cs'' xf where [simp]: "x = (cs'',xf)"
         by (cases x', fastforce)
       with ex_edge v_not_def show ?thesis
         apply (auto elim!: JVM_CFG.cases)
          by (cases V, auto intro!: Def_Exc_Stk)+
     qed
   next
     case [simp]: (Invoke M' n')
     show ?thesis
     proof (cases x)
       case None
       with ex_edge show ?thesis
         by (auto elim: JVM_CFG.cases)
     next
       case (Some x')
       then obtain cs'' xf where [simp]: "x = (cs'',xf)"
         by (cases x', fastforce)
       from ex_edge v_not_def show ?thesis
         apply (auto elim!: JVM_CFG.cases)
           apply (cases V, auto intro!: Def_Invoke_Loc)
          by (cases V, auto intro!: Def_Exc_Stk)+
     qed
   next
     case Return
     with ex_edge v_not_def show ?thesis
       apply (auto elim!: JVM_CFG.cases)
       by (cases V, auto intro!: Def_Return_Stk)
   next
     case Pop
     with ex_edge show ?thesis
       by (auto elim: JVM_CFG.cases)
   next
     case IAdd
     with ex_edge v_not_def show ?thesis
       apply (auto elim!: JVM_CFG.cases)
       by (cases V, auto intro!: Def_IAdd_Stk)
   next
     case (IfFalse b)
     with ex_edge show ?thesis
       by (auto elim: JVM_CFG.cases)
   next
     case CmpEq
     with ex_edge v_not_def show ?thesis
       apply (auto elim!: JVM_CFG.cases)
       by (cases V, auto intro!: Def_CmpEq_Stk)
   next
     case (Goto i)
     with ex_edge show ?thesis
       by (auto elim: JVM_CFG.cases)
   next
     case [simp]: Throw
     show ?thesis
     proof (cases x)
       case None
       with ex_edge show ?thesis
         by (auto elim: JVM_CFG.cases)
     next
       case (Some x')
       then obtain cs'' xf where [simp]: "x = (cs'',xf)"
         by (cases x', fastforce)
       from ex_edge v_not_def show ?thesis
         apply (auto elim!: JVM_CFG.cases)
          by (cases V, auto intro!: Def_Exc_Stk)+
      qed
    qed
  next
    case Entry
    with ex_edge show ?thesis
      by (auto elim: JVM_CFG.cases)
  qed
qed

interpretation JVM_CFG_wf: CFG_wf
  "sourcenode" "targetnode" "kind" "valid_edge prog" "(_Entry_)"
  "Def (fst prog)" "Use (fst prog)" "state_val"
  for prog
proof (unfold_locales)
  show "Def (fst prog) (_Entry_) = {}  Use (fst prog) (_Entry_) = {}"
    by (auto elim: Def.cases Use.cases)
next
  fix a V s
  assume ve:"valid_edge prog a"
    and v_not_def: "V  Def (fst prog) (sourcenode a)"
  thus "state_val (transfer (kind a) s) V = state_val s V"
    by -(cases prog,
    rule edge_no_Def_equal [of "fst prog" "fst (snd prog)" "snd (snd prog)"], auto)
next
  fix a s s'
  assume ve: "valid_edge prog a"
    and use_eq: "VUse (fst prog) (sourcenode a). state_val s V = state_val s' V"
  thus "VDef (fst prog) (sourcenode a).
    state_val (transfer (kind a) s) V = state_val (transfer (kind a) s') V"
    by -(cases prog,
      rule edge_transfer_uses_only_Use [of "fst prog" "fst(snd prog)" "snd(snd prog)"], auto)
next
  fix a s s'
  assume ve: "valid_edge prog a"
    and pred: "pred (kind a) s"
    and use_eq: "VUse (fst prog) (sourcenode a). state_val s V = state_val s' V"
  thus "pred (kind a) s'"
    by -(cases prog,
      rule CFG_edge_Uses_pred_equal [of "fst prog" "fst(snd prog)" "snd(snd prog)"], auto)
next
  fix a a'
  assume ve_a: "valid_edge prog a"
    and ve_a': "valid_edge prog a'"
    and src_eq: "sourcenode a = sourcenode a'"
    and trg_neq: "targetnode a  targetnode a'"
  hence "prog  (sourcenode a)-kind a(targetnode a)"
    and "prog  (sourcenode a')-kind a'(targetnode a')"
    by simp_all
  with src_eq trg_neq
  show "Q Q'. kind a = (Q)  kind a' = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
    apply (cases prog, auto)
    apply (erule JVM_CFG.cases, erule_tac [!] JVM_CFG.cases)
    (* This takes veeery long! *)
    by simp_all
qed

interpretation JVM_CFGExit_wf: CFGExit_wf
  "sourcenode" "targetnode" "kind" "valid_edge prog" "(_Entry_)"
  "Def (fst prog)" "Use (fst prog)" "state_val" "(_Exit_)"
proof
  show "Def (fst prog) (_Exit_) = {}  Use (fst prog) (_Exit_) = {}"
    by(fastforce elim:Def.cases Use.cases)
qed

  
end

Theory JVMControlDependences

section ‹Instantiating the control dependences›

theory JVMControlDependences imports
  JVMPostdomination
  JVMCFG_wf
  "../Dynamic/DynPDG"
  "../StaticIntra/CDepInstantiations"
begin

subsection ‹Dynamic dependences›

interpretation JVMDynStandardControlDependence:
  DynStandardControlDependencePDG "sourcenode" "targetnode" "kind" 
  "valid_edgeCFG prog" "(_Entry_)" "Def (fstCFG prog)" "Use (fstCFG prog)" 
  "state_val" "(_Exit_)" .. 

interpretation JVMDynWeakControlDependence:
  DynWeakControlDependencePDG "sourcenode" "targetnode" "kind" 
  "valid_edgeCFG prog" "(_Entry_)" "Def (fstCFG prog)" "Use (fstCFG prog)" 
  "state_val" "(_Exit_)" ..

subsection ‹Static dependences›

interpretation JVMStandardControlDependence:
  StandardControlDependencePDG "sourcenode" "targetnode" "kind" 
  "valid_edgeCFG prog" "(_Entry_)" "Def (fstCFG prog)" "Use (fstCFG prog)" 
  "state_val" "(_Exit_)" ..

interpretation JVMWeakControlDependence:
  WeakControlDependencePDG "sourcenode" "targetnode" "kind" 
  "valid_edgeCFG prog" "(_Entry_)" "Def (fstCFG prog)" "Use (fstCFG prog)" 
  "state_val" "(_Exit_)" ..

end



Theory SemanticsWF

chapter ‹Equivalence of the CFG and Jinja›

theory SemanticsWF imports JVMInterpretation "../Basic/SemanticsCFG" begin

declare rev_nth [simp add]

section ‹State updates›

text ‹
The following abbreviations update the stack and the local variables (in the representation
as used in the CFG) according to a frame list› as it is used in Jinja's
state representation.
›

abbreviation update_stk :: "((nat × nat)  val)  (frame list)  ((nat × nat)  val)"
where
  "update_stk stk frs  (λ(a, b).
    if length frs  a then stk (a, b)
      else let xs = fst (frs ! (length frs - Suc a))
        in if length xs  b then stk (a, b) else xs ! (length xs - Suc b))"

abbreviation update_loc :: "((nat × nat)  val)  (frame list)  ((nat × nat)  val)"
where
  "update_loc loc frs  (λ(a, b).
    if length frs  a then loc (a, b)
      else let xs = fst (snd (frs ! (length frs - Suc a)))
        in if length xs  b then loc (a, b) else xs ! b)"

subsection ‹Some simplification lemmas›

lemma update_loc_s2jvm [simp]:
  "update_loc loc (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = loc"
  by (auto intro!: ext simp: nth_locss)

lemma update_stk_s2jvm [simp]:
  "update_stk stk (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = stk"
  by (auto intro!: ext simp: nth_stkss)

lemma update_loc_s2jvm' [simp]:
  "update_loc loc (zip (stkss P cs stk) (zip (locss P cs loc) cs)) = loc"
  by (auto intro!: ext simp: nth_locss)

lemma update_stk_s2jvm' [simp]:
  "update_stk stk (zip (stkss P cs stk) (zip (locss P cs loc) cs)) = stk"
  by (auto intro!: ext simp: nth_stkss)

lemma find_handler_find_handler_forD:
  "find_handler (Pwf) a h frs = (xp',h',frs')
   find_handler_for P (cname_of h a) (framestack_to_callstack frs) =
       framestack_to_callstack frs'"
  by (induct frs, auto)

lemma find_handler_nonempty_frs [simp]:
  "(find_handler P a h frs  (None, h', []))"
  by (induct frs, auto)

lemma find_handler_heap_eqD:
  "find_handler P a h frs = (xp, h', frs')  h' = h"
  by (induct frs, auto)

lemma find_handler_frs_decrD:
  "find_handler P a h frs = (xp, h', frs')  length frs'  length frs"
  by (induct frs, auto)

lemma find_handler_decrD [dest]:
  "find_handler P a h frs = (xp, h', f#frs)  False"
  by (drule find_handler_frs_decrD, simp)

lemma find_handler_decrD' [dest]:
  " find_handler P a h frs = (xp,h',f#frs'); length frs = length frs'   False"
  by (drule find_handler_frs_decrD, simp)

lemma Suc_minus_Suc_Suc [simp]:
  "b < n - 1  Suc (n - Suc (Suc b)) = n - Suc b"
  by simp

lemma find_handler_loc_fun_eq':
  "find_handler (Pwf) a h
    (zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
  (xf, h', frs)
   update_loc loc frs = loc"
proof
  fix x
  obtain a' b' where x: "x = (a'::nat,b'::nat)" by fastforce
  assume find_handler: "find_handler (Pwf) a h
    (zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
    (xf, h', frs)"
  thus "update_loc loc frs x = loc x"
  proof (induct cs)
    case Nil
    thus ?case by simp
  next
    case (Cons aa cs')
    then obtain C M pc where step_case: "find_handler (Pwf) a h
      (zip (stkss P ((C,M,pc) # cs') stk)
      (zip (locss P ((C,M,pc) # cs') loc) ((C,M,pc) # cs'))) =
      (xf, h', frs)"
      by (cases aa, clarsimp)
    note IH = ‹find_handler (Pwf) a h
      (zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) =
      (xf, h', frs) 
      update_loc loc frs x = loc x
    show ?thesis
    proof (cases "match_ex_table (Pwf) (cname_of h a) pc (ex_table_of (Pwf) C M)")
      case None
      with step_case IH show ?thesis
        by simp
    next
      case (Some e)
      with step_case x
      show ?thesis
        by (cases "length cs' = a'",
            auto simp: nth_Cons' (* nth_locs *) nth_locss)
    qed
  qed
qed

lemma find_handler_loc_fun_eq:
  "find_handler (Pwf) a h (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = (xf,h',frs)
   update_loc loc frs = loc"
  by (simp add: find_handler_loc_fun_eq')

lemma find_handler_stk_fun_eq':
  "find_handler (Pwf) a h
    (zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
  (None, h', frs);
  cd = length frs - 1;
  i = length (fst(hd(frs))) - 1 
   update_stk stk frs = stk((cd, i) := Addr a)"
proof
  fix x
  obtain a' b' where x: "x = (a'::nat,b'::nat)" by fastforce
  assume find_handler: "find_handler (Pwf) a h
    (zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
    (None, h', frs)"
    and calldepth: "cd = length frs - 1"
    and idx: "i = length (fst (hd frs)) - 1"
  from find_handler have "frs  []"
    by clarsimp
  then obtain stk' loc' C' M' pc' frs' where frs: "frs = (stk',loc',C',M',pc')#frs'"
    by (cases frs, fastforce+)
  from find_handler
  show "update_stk stk frs x = (stk((cd, i) := Addr a)) x"
  proof (induct cs)
    case Nil
    thus ?case by simp
  next
    case (Cons aa cs')
    then obtain C M pc where step_case: "find_handler (Pwf) a h
      (zip (stkss P ((C,M,pc) # cs') stk)
      (zip (locss P ((C,M,pc) # cs') loc) ((C,M,pc) # cs'))) =
      (None, h', frs)"
      by (cases aa, clarsimp)
    note IH = ‹find_handler (Pwf) a h
      (zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) =
      (None, h', frs) 
      update_stk stk frs x = (stk((cd, i) := Addr a)) x
    show ?thesis
    proof (cases "match_ex_table (Pwf) (cname_of h a) pc (ex_table_of (Pwf) C M)")
      case None
      with step_case IH show ?thesis
        by simp
    next
      case (Some e)
      show ?thesis
      proof (cases "a' = length cs'")
        case True
        with Some step_case frs calldepth idx x
        show ?thesis
          by (fastforce simp: nth_Cons')
      next
        case False
        with Some step_case frs calldepth idx x
        show ?thesis
          by (fastforce simp: nth_Cons' nth_stkss)
      qed
    qed
  qed
qed

lemma find_handler_stk_fun_eq:
  "find_handler (Pwf) a h (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = (None,h',frs)
   update_stk stk frs = stk((length frs - 1, length (fst(hd(frs))) - 1) := Addr a)"
  by (simp add: find_handler_stk_fun_eq')

lemma f2c_emptyD [dest]:
  "framestack_to_callstack frs = []  frs = []"
  by (simp add: framestack_to_callstack_def)

lemma f2c_emptyD' [dest]:
  "[] = framestack_to_callstack frs  frs = []"
  by (simp add: framestack_to_callstack_def)

lemma correct_state_imp_valid_callstack:
  " P,csBV s ; fst (last cs) = C0; fst(snd (last cs)) = Main 
   valid_callstack (P,C0,Main) cs"
proof (cases cs rule: rev_cases)
  case Nil
  thus ?thesis by simp
next
  case (snoc cs' y)
  assume bv_correct: "P,csBV s "
    and last_C: "fst (last cs) = C0"
    and last_M: "fst(snd (last cs)) = Main"
  with snoc obtain pcX where [simp]: "cs = cs'@[(C0,Main,pcX)]"
    by (cases "last cs", fastforce)
  obtain h stk loc where [simp]: "s = (h,stk,loc)"
    by (cases s, fastforce)
  from bv_correct show ?thesis
  proof (cases "snd(snd(state_to_jvm_state P cs s))")
    case Nil
    thus ?thesis
      by (cases cs', auto)
  next
    case [simp]: (Cons a frs')
    obtain stk' loc' C M pc where [simp]: "a = (stk', loc', C, M, pc)" by (cases a, fastforce)
    from Cons bv_correct show ?thesis
      apply clarsimp
    proof (induct cs' arbitrary: stk' loc' C M pc frs')
      case Nil
      thus ?case by (fastforce simp: bv_conform_def)
    next
      case (Cons a' cs'')
      then have [simp]: "a' = (C,M,pc)"
        by (cases a', fastforce)
      from Cons obtain T Ts mxs mxl "is" xt
        where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
        by (clarsimp simp: bv_conform_def correct_state_def)
      with Cons
      have "pc < length is"
        by (auto dest: sees_method_fun
                 simp: bv_conform_def)
      from wf_jvmprog_is_wf [of P] sees_M
      have "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
        by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
      with pc < length is sees_M
      have "length Ts = locLength P C M 0 - Suc mxl"
        by (auto dest!: list_all2_lengthD
                  simp: wt_method_def wt_start_def)
      with Cons sees_M show ?case
        by (cases cs'',
            (fastforce dest: sees_method_fun simp: bv_conform_def)+)
    qed
  qed
qed

declare correct_state_def [simp del]

lemma bool_sym: "Bool (a = b) = Bool (b = a)"
  by auto

lemma find_handler_exec_correct:
  "(Pwf),(PΦ)  state_to_jvm_state P cs (h,stk,loc) ;
    (Pwf),(PΦ)  find_handler (Pwf) a h
      (zip (stkss P cs stk) (zip (locss P cs loc) cs)) ;
    find_handler_for P (cname_of h a) cs = (C', M', pc') # cs'
   
  (Pwf),(PΦ)  (None, h,
    (stks (stkLength P C' M' pc')
      (λa'. (stk((length cs', stkLength P C' M' pc' - Suc 0) := Addr a)) (length cs', a')),
     locs (locLength P C' M' pc') (λa. loc (length cs', a)), C', M', pc') #
    zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) "
proof (induct cs)
  case Nil
  thus ?case by simp
next
  case (Cons aa cs)
  note state_correct = Pwf,PΦ  state_to_jvm_state P (aa # cs) (h, stk, loc) 
  note IH = Pwf,PΦ  state_to_jvm_state P cs (h, stk, loc) ;
         Pwf,PΦ  find_handler Pwf a h (zip (stkss P cs stk) (zip (locss P cs loc) cs)) ;
         find_handler_for P (cname_of h a) cs = (C', M', pc') # cs'
         Pwf,PΦ  (None, h,
                     (stks (stkLength P C' M' pc')
                       (λa'. (stk((length cs', stkLength P C' M' pc' - Suc 0) := Addr a))
                              (length cs', a')),
                      locs (locLength P C' M' pc') (λa. loc (length cs', a)), C', M', pc') #
                     zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) 
  note trg_state_correct = Pwf,PΦ  find_handler Pwf a h
            (zip (stkss P (aa # cs) stk)
              (zip (locss P (aa # cs) loc) (aa # cs))) 
  note fhf = ‹find_handler_for P (cname_of h a) (aa # cs) = (C', M', pc') # cs'
  obtain C M pc where [simp]: "aa = (C,M,pc)" by (cases aa, fastforce)
  note P_wf = wf_jvmprog_is_wf [of P]
  from state_correct
  have cs_state_correct: "Pwf,PΦ  state_to_jvm_state P cs (h, stk, loc) "
    apply (auto simp: correct_state_def)
    apply (cases "zip (stkss P cs stk) (zip (locss P cs loc) cs)")
     by fastforce+
  show ?thesis
  proof (cases "match_ex_table (Pwf) (cname_of h a) pc (ex_table_of (Pwf) C M)")
    case None
    with trg_state_correct fhf cs_state_correct IH show ?thesis
      by clarsimp
  next
    case (Some xte)
    with IH trg_state_correct fhf state_correct show ?thesis
      apply (cases "stkLength P C' M' (fst xte)", auto)
       apply (clarsimp simp: correct_state_def)
      apply (auto simp: correct_state_def)
      apply (rule_tac x="Ts" in exI)
      apply (rule_tac x="T" in exI)
      apply (rule_tac x="mxs" in exI)
      apply (rule_tac x="mxl0" in exI)
      apply (rule_tac x="is" in exI)
      apply (rule conjI)
       apply (rule_tac x="xt" in exI)
       apply clarsimp
      apply clarsimp
      apply (drule sees_method_fun, fastforce, clarsimp)
      apply (auto simp: list_all2_Cons1)
       apply (rule list_all2_all_nthI)
        apply clarsimp
       apply clarsimp
       apply (frule_tac ys="zs" in list_all2_lengthD)
       apply clarsimp
       apply (drule_tac p="n" and ys="zs" in list_all2_nthD)
        apply clarsimp
       apply clarsimp
       apply (case_tac "length aa - Suc (length aa - snd xte + n) = length zs - Suc n")
        apply clarsimp
       apply clarsimp
      apply (rule list_all2_all_nthI)
       apply clarsimp
      apply (frule_tac p="n" and ys="b" in list_all2_nthD)
       apply (clarsimp dest!: list_all2_lengthD)
      by (clarsimp dest!: list_all2_lengthD)
  qed
qed

lemma locs_rev_stks:
  "x  z 
  locs z
    (λb.
      if z < b then loc (Suc y, b)
        else if b  z
          then stk (y, x + b - Suc z)
          else arbitrary)
  @ [stk (y, x - Suc 0)]
  =
  stk (y, x - Suc (z))
  # rev (take z (stks x (λa. stk(y, a))))"
apply (rule nth_equalityI)
 apply (simp)
apply (auto simp: nth_append nth_Cons' (* nth_locs *) less_Suc_eq min.absorb2 max.absorb2)
done

lemma locs_invoke_purge:
  "(z::nat) > c 
  locs l
    (λb. if z = c  Q b then loc (c, b) else u b) =
  locs l (λa. loc (c, a))"
  by (induct l, auto)


lemma nth_rev_equalityI:
  "length xs = length ys; i<length xs. xs ! (length xs - Suc i) = ys ! (length ys - Suc i)
   xs = ys"
proof (induct xs ys rule: list_induct2)
  case Nil
  thus ?case by simp
next
  case (Cons x xs y ys)
  hence "i<length ys. xs ! (length ys - Suc i) = ys ! (length ys - Suc i)"
    apply auto
    apply (erule_tac x="i" in allE)
    by (auto simp: nth_Cons')
  with Cons show ?case
    by (auto simp: nth_Cons)
qed

lemma length_locss:
  "i < length cs
   length (locss P cs loc ! (length cs - Suc i)) =
  locLength P (fst(cs ! (length cs - Suc i)))
              (fst(snd(cs ! (length cs - Suc i))))
              (snd(snd(cs ! (length cs - Suc i))))"
apply (induct cs, auto)
apply (case_tac "i = length cs")
 by (auto simp: nth_Cons')

lemma locss_invoke_purge:
  "z > length cs 
  locss P cs
    (λ(a, b). if (a = z  Q b)
      then loc (a, b)
      else u b)
  = locss P cs loc"
  by (induct cs, auto simp: locs_invoke_purge [simplified])

lemma stks_purge':
  "d  b  stks b (λx. if x = d then e else stk x) = stks b stk"
  by simp

subsection ‹Byte code verifier conformance›

text ‹Here we prove state conformance invariant under transfer› for
our CFG. Therefore, we must assume, that the predicate of a potential preceding
predicate-edge holds for every update-edge.
›
 
theorem bv_invariant:
  " valid_edge (P,C0,Main) a;
  sourcenode a = (_ (C,M,pc)#cs,x _);
  targetnode a = (_ (C',M',pc')#cs',x' _);
  pred (kind a) s;
  x  None  (a_pred. 
    sourcenode a_pred = (_ (C,M,pc)#cs,None _) 
    targetnode a_pred = sourcenode a 
    valid_edge (P,C0,Main) a_pred 
    pred (kind a_pred) s
  );
  P,((C,M,pc)#cs)BV s  
   P,((C',M',pc')#cs')BV transfer (kind a) s "
proof -
  assume ve: "valid_edge (P, C0, Main) a"
    and src [simp]: "sourcenode a = (_ (C,M,pc)#cs,x _)"
    and trg [simp]: "targetnode a = (_ (C',M',pc')#cs',x' _)"
    and pred_s: "pred (kind a) s"
    and a_pred: "x  None  (a_pred. 
      sourcenode a_pred = (_ (C,M,pc)#cs,None _) 
      targetnode a_pred = sourcenode a 
      valid_edge (P,C0,Main) a_pred 
      pred (kind a_pred) s
    )"
    and state_correct: "P,((C,M,pc)#cs)BV s "
  obtain h stk loc where s [simp]: "s = (h,stk,loc)" by (cases s, fastforce)
  note P_wf = wf_jvmprog_is_wf [of P]
  from ve obtain Ts T mxs mxl "is" xt
    where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
    and "pc < length is"
    and reachable: "PΦ C M ! pc  None"
    by (cases x) (cases cs, auto)+
  from P_wf sees_M
  have wt_method: "wt_method (Pwf) C Ts T mxs mxl is xt (PΦ C M)"
    by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
  with sees_M pc < length is reachable
  have applicable: "appi ((is ! pc),(Pwf),pc,mxs,T,(the(PΦ C M ! pc)))"
    by (auto simp: wt_method_def)
  from state_correct ve P_wf
  have trg_state_correct:
    "(Pwf),(PΦ)  the (JVMExec.exec ((Pwf), state_to_jvm_state P ((C,M,pc)#cs) s)) "
    apply simp
    apply (drule BV_correct_1)
      apply (fastforce simp: bv_conform_def)
     apply (simp add: exec_1_iff)
    apply (cases "instrs_of (Pwf) C M ! pc")
    apply (simp_all add: split_beta)
    done
  from reachable obtain ST LT where reachable: "(PΦ) C M ! pc = (ST, LT)"
    by fastforce
  with wt_method sees_M pc < length is
  have stk_loc_succs:
    "pc'  set (succs (is ! pc) (ST, LT) pc).
    stkLength P C M pc' = length (fst (effi (is ! pc, (Pwf), ST, LT))) 
    locLength P C M pc' = length (snd (effi (is ! pc, (Pwf), ST, LT)))"
    unfolding wt_method_def apply (cases "is ! pc")
    using [[simproc del: list_to_set_comprehension]]
    apply (cases "is ! pc")
    apply (tactic PARALLEL_ALLGOALS
      (Clasimp.fast_force_tac (@{context} addSDs @{thms list_all2_lengthD})))
    done
  have [simp]: "x. x" by auto
  have [simp]: "Ex Not" by auto
  show ?thesis
  proof (cases "instrs_of (Pwf) C M ! pc")
    case (Invoke m n)
    from state_correct have "preallocated h"
      by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
    from Invoke applicable sees_M have "stkLength P C M pc > n"
      by (cases "the (PΦ C M ! pc)") auto
    show ?thesis
    proof (cases x)
      case [simp]: None
      with ve Invoke obtain Q where kind: "kind a = (Q)"
        by (auto elim!: JVM_CFG.cases)
      with ve Invoke have "(C',M',pc')#cs' = (C,M,pc)#cs"
        by (auto elim!: JVM_CFG.cases)
      with state_correct kind show ?thesis
        by simp
    next
      case [simp]: (Some aa)
      with ve Invoke obtain xf where [simp]: "aa = ((C',M',pc')#cs' , xf)"
        by (auto elim!: JVM_CFG.cases)
      from ve Invoke obtain f where kind: "kind a = f"
        apply -
        apply clarsimp
        apply (erule JVM_CFG.cases)
        apply auto
        done
      show ?thesis
      proof (cases xf)
        case [simp]: True
        with a_pred Invoke have stk_n: "stk (length cs, stkLength P C M pc - Suc n) = Null"
          apply auto
          apply (erule JVM_CFG.cases)
          apply simp_all
          done
        from ve Invoke kind
        have [simp]: "f = (λ(h,stk,loc).
          (h, 
           stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
          loc))"
          apply -
          apply clarsimp
          apply (erule JVM_CFG.cases)
          apply auto
          done
        from ve Invoke
        have "find_handler_for P NullPointer ((C,M,pc)#cs) = (C',M',pc')#cs'"
          apply -
          apply clarsimp
          apply (erule JVM_CFG.cases)
          apply auto
          done
        with Invoke state_correct kind stk_n trg_state_correct applicable sees_M
          ‹preallocated h
        show ?thesis
          apply (cases "the (PΦ C M ! pc)",
                 auto simp: bv_conform_def stkss_purge
                  simp del: find_handler_for.simps exec.simps appi.simps fun_upd_apply)
          apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct)
            apply fastforce
           apply (fastforce simp: split_beta split: if_split_asm)
          apply fastforce
          done
      next
        case [simp]: False
        from a_pred Invoke
        have [simp]: "m = M'"
          by -(clarsimp, erule JVM_CFG.cases, auto)
        from a_pred Invoke
        have [simp]: "pc' = 0"
          by -(clarsimp, erule JVM_CFG.cases, auto)
        from ve Invoke
        have [simp]: "cs' = (C,M,pc)#cs"
          by -(clarsimp, erule JVM_CFG.cases, auto)
        from ve Invoke kind
        have [simp]:
          "f = (λs. exec_instr (Invoke m n) P s (length cs) (stkLength P C M pc)
                               arbitrary (locLength P C' M' 0))"
          by -(clarsimp, erule JVM_CFG.cases, auto)
        from state_correct obtain ST LT where [simp]:
          "(PΦ) C M ! pc = (ST,LT)"
          by (auto simp: bv_conform_def correct_state_def)
        from a_pred Invoke
        have [simp]:
          "fst (method (Pwf)
          (cname_of h (the_Addr (stk (length cs, length ST - Suc n)))) M') = C'"
          by -(clarsimp, erule JVM_CFG.cases, auto)
        from a_pred Invoke
        have [simp]: "stk (length cs, length ST - Suc n)  Null"
          by -(clarsimp, erule JVM_CFG.cases, auto)
        from state_correct applicable sees_M Invoke
        have [simp]: "ST ! n  NT"
          apply (auto simp: correct_state_def bv_conform_def)
          apply (drule_tac p="n" and ys="ST" in list_all2_nthD)
           apply simp
          by clarsimp
        from applicable Invoke sees_M
        have "length ST > n"
          by auto
        with trg_state_correct Invoke
        have [simp]: "stkLength P C' M' 0 = 0"
          by (auto simp: split_beta correct_state_def
                  split: if_split_asm)
        from trg_state_correct Invoke ‹length ST > n
        have "locLength P C' M' 0 =
          Suc n + fst(snd(snd(snd(snd(method (Pwf) 
                   (cname_of h (the_Addr (stk (length cs, length ST - Suc n)))) M')))))"
          by (auto simp: split_beta  (* nth_stks *) correct_state_def
                  dest!: list_all2_lengthD
                  split: if_split_asm)
        with Invoke state_correct trg_state_correct ‹length ST > n
        have "JVMExec.exec  (Pwf, state_to_jvm_state P ((C, M, pc) # cs) s)
            =
            (None, h,
                 (stks (stkLength P C' M' pc') (λa. stk (Suc (length cs), a)),
                  locs (locLength P C' M' pc')
                   (λa'. (λ(a, b).
                       if a = Suc (length cs)  locLength P C' M' 0  b then loc (a, b)
                       else if b  n then stk (length cs, length ST - (Suc n - b))
                            else arbitrary) (Suc (length cs), a')),
                  C', M', pc') #
                 (stks (length ST) (λa. stk (length cs, a)),
                  locs (length LT) (λa. loc (length cs, a)), C, M, pc) #
                 zip (stkss P cs stk) (zip (locss P cs loc) cs))"
          apply (auto simp: split_beta  (* nth_stks *) bv_conform_def)
           apply (rule nth_equalityI)
            apply simp
           apply (cases ST,
                  auto simp: nth_Cons' nth_append min.absorb1 min.absorb2)
          apply (rule nth_equalityI)
           apply simp
          by (auto simp: (* nth_locs *) (* nth_stks *) rev_nth nth_Cons' nth_append min_def)
        with Invoke state_correct kind trg_state_correct applicable sees_M
        show ?thesis
          apply (cases "the (PΦ C M ! pc)",
                 auto simp: bv_conform_def stkss_purge rev_nth (* nth_stks *)
                    simp del: find_handler_for.simps exec.simps appi.simps)
          apply(subst locss_invoke_purge, simp)
          by simp
      qed
    qed
  next
    case (Load nat)
    with stk_loc_succs sees_M reachable
    have "stkLength P C M (Suc pc) = Suc (stkLength P C M pc)"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by simp_all
    with state_correct ve P_wf applicable sees_M Load trg_state_correct
    show ?thesis
      apply auto
      apply (erule JVM_CFG.cases, simp_all)
      by (auto simp: bv_conform_def stkss_purge stks_purge')
  next
    case (Store nat)
    with stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M Store trg_state_correct
    show ?thesis
      apply auto
      apply (erule JVM_CFG.cases, simp_all)
      by (auto simp: bv_conform_def locss_purge)
  next
    case (Push val)
    with stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = Suc (stkLength P C M pc)"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M Push trg_state_correct
    show ?thesis
      apply auto
      apply (erule JVM_CFG.cases, simp_all)
      by (auto simp: bv_conform_def stks_purge' stkss_purge)
  next
    case Pop
    with stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M Pop trg_state_correct
    show ?thesis
      apply auto
      apply (erule JVM_CFG.cases, simp_all)
      by (auto simp: bv_conform_def)
  next
    case IAdd
    with stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M IAdd trg_state_correct
    show ?thesis
      apply auto
      apply (erule JVM_CFG.cases, simp_all)
      by (auto simp: bv_conform_def stks_purge' stkss_purge add.commute)
  next
    case CmpEq
    with stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M CmpEq trg_state_correct
    show ?thesis
      apply auto
       apply (erule JVM_CFG.cases, simp_all)
       apply (auto simp: bv_conform_def stks_purge' stkss_purge bool_sym)
      apply (erule JVM_CFG.cases, simp_all)
      by (auto simp: bv_conform_def stks_purge' stkss_purge bool_sym)
  next
    case (Goto b)
    with stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (nat (int pc + b)) = stkLength P C M pc"
      and "locLength P C M (nat (int pc + b)) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M Goto trg_state_correct
    show ?thesis
      apply auto
      by (erule JVM_CFG.cases, simp_all add: bv_conform_def)
  next
    case (IfFalse b)
    have nat_int_pc_conv: "nat (int pc + 1) = pc + 1"
      by (cases pc) auto
    from IfFalse stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
      and "stkLength P C M (nat (int pc + b)) = stkLength P C M pc - 1"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      and "locLength P C M (nat (int pc + b)) = locLength P C M pc"
      by auto
    with state_correct ve P_wf applicable sees_M IfFalse pred_s nat_int_pc_conv
      trg_state_correct
    show ?thesis
      apply auto
      apply (erule JVM_CFG.cases, simp_all)
       by (auto simp: bv_conform_def split: if_split_asm)
  next
    case Return
    with ve obtain Ts' T' mxs' mxl' is' xt'
      where sees_M': "(Pwf)  C' sees M':Ts'T' = (mxs',mxl',is',xt') in C'"
      and "(pc' - 1) < length is'"
      and reachable': "PΦ C' M' ! (pc' - 1)  None"
      apply auto
      apply (erule JVM_CFG.cases, auto)
      by (cases cs', auto)
    with Return ve wt_method sees_M applicable
    have "is' ! (pc' - 1) = Invoke M (length Ts)"
      apply auto
      apply (erule JVM_CFG.cases, auto)
      apply (drule sees_method_fun, fastforce, clarsimp)
      by (auto dest!: list_all2_lengthD simp: wt_method_def wt_start_def)
    from P_wf sees_M'
    have "wt_method (Pwf) C' Ts' T' mxs' mxl' is' xt' (PΦ C' M')"
      by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
    with ve Return pc' - 1 < length is' reachable' sees_M state_correct
    have "stkLength P C' M' pc' = stkLength P C' M' (pc' - 1) - length Ts"
      using [[simproc del: list_to_set_comprehension]]
      apply auto
      apply (erule JVM_CFG.cases, auto)
      apply (drule sees_method_fun, fastforce, clarsimp)
      using sees_M'
      apply hypsubst_thin
      apply (auto simp: wt_method_def)
      apply (erule_tac x="pc'" in allE)
      apply (auto simp: bv_conform_def correct_state_def not_less_eq less_Suc_eq)
       apply (drule sees_method_fun, fastforce, clarsimp)
       apply (drule sees_method_fun, fastforce, clarsimp)
      apply (auto simp: wt_start_def)
      apply (auto dest!: list_all2_lengthD)
      apply (drule sees_method_fun, fastforce, clarsimp)
      apply (drule sees_method_fun, fastforce, clarsimp)
      by auto
    from ‹wt_method (Pwf) C' Ts' T' mxs' mxl' is' xt' (PΦ C' M')
      (pc' - 1) < length is' PΦ C' M' ! (pc' - 1)  None›
      is' ! (pc' - 1) = Invoke M (length Ts)
    have "stkLength P C' M' (pc' - 1) > 0"
      by (fastforce simp: wt_method_def)
    then obtain ST' STr' where [simp]: "fst (the (PΦ C' M' ! (pc' - 1))) = ST'#STr'"
      by (cases "fst (the (PΦ C' M' ! (pc' - 1)))", fastforce+)
    from wt_method
    have "locLength P C M 0 = Suc (length Ts) + mxl"
      by (auto dest!: list_all2_lengthD
                simp: wt_method_def wt_start_def)
    from ‹wt_method (Pwf) C' Ts' T' mxs' mxl' is' xt' (PΦ C' M')
      ve Return pc' - 1 < length is' reachable' sees_M state_correct
    have "locLength P C' M' (pc' - 1) = locLength P C' M' pc'"
      using [[simproc del: list_to_set_comprehension]]
      apply auto
      apply (erule JVM_CFG.cases, auto)
      apply (drule sees_method_fun, fastforce, clarsimp)
      using sees_M'
      apply hypsubst_thin
      apply (auto simp: wt_method_def)
      apply (erule_tac x="pc'" in allE)
      apply (auto simp: wt_start_def)
       apply (clarsimp simp: bv_conform_def correct_state_def)
       apply (drule sees_method_fun, fastforce, clarsimp)
       apply (drule sees_method_fun, fastforce, clarsimp)
      by (auto dest!: list_all2_lengthD)
    with ‹stkLength P C' M' pc' = stkLength P C' M' (pc' - 1) - length Ts
      Return state_correct ve P_wf applicable sees_M trg_state_correct sees_M'
      ‹fst (the (PΦ C' M' ! (pc' - 1))) = ST'#STr' is' ! (pc' - 1) = Invoke M (length Ts)
      ‹locLength P C M 0 = Suc (length Ts) + mxl
    show ?thesis
      apply (auto simp: bv_conform_def)
      apply (erule JVM_CFG.cases, auto simp: stkss_purge locss_purge)
      apply (drule sees_method_fun, fastforce, clarsimp)
      apply (auto simp: correct_state_def)
      apply (drule sees_method_fun, fastforce, clarsimp)
      apply (drule sees_method_fun, fastforce, clarsimp)
      apply (drule sees_method_fun, fastforce, clarsimp)
      apply (rule_tac x="Ts'" in exI)
      apply (rule_tac x="T'" in exI)
      apply (rule_tac x="mxs'" in exI)
      apply (rule_tac x="mxl'" in exI)
      apply (rule_tac x="is'" in exI)
      apply clarsimp
      apply (rule conjI)
       apply (rule_tac x="xt'" in exI)
       apply clarsimp
      apply (rule list_all2_all_nthI)
       apply clarsimp
      apply clarsimp
      apply (auto simp: rev_nth (* nth_stks *) list_all2_Cons1)
       apply (case_tac n, auto simp: list_all2_Cons1)
      apply (case_tac n, auto simp: list_all2_Cons1)
      apply (drule_tac p="nat" and ys="zs" in list_all2_nthD2)
       apply clarsimp
      by auto
  next
    case (New Cl)
    from state_correct have "preallocated h"
      by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
    from New stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = Suc (stkLength P C M pc)"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with New state_correct ve sees_M trg_state_correct applicable a_pred ‹preallocated h
    show ?thesis
      apply (clarsimp simp del: exec.simps)
      apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       defer
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
       apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
         apply fastforce
        apply fastforce
       apply clarsimp
      by (auto simp: split_beta bv_conform_def stks_purge' stkss_purge
           simp del: find_handler_for.simps)
  next
    case (Getfield Fd Cl)
    from state_correct have "preallocated h"
      by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
    from Getfield stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with Getfield state_correct ve sees_M trg_state_correct applicable a_pred ‹preallocated h
    show ?thesis
      apply (clarsimp simp del: exec.simps)
      apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       defer
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
       apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
         apply fastforce
        apply (fastforce simp: split_beta)
       apply clarsimp
      by (auto simp: split_beta bv_conform_def stks_purge' stkss_purge
           simp del: find_handler_for.simps)
  next
    case (Putfield Fd Cl)
    from state_correct have "preallocated h"
      by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
    from Putfield stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc - 2"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with Putfield state_correct ve sees_M trg_state_correct applicable a_pred ‹preallocated h
    show ?thesis
      apply (clarsimp simp del: exec.simps)
      apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       defer
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
       apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
         apply fastforce
        apply (fastforce simp: split_beta)
       apply clarsimp
      by (auto simp: split_beta bv_conform_def stks_purge' stkss_purge
           simp del: find_handler_for.simps)
  next
    case (Checkcast Cl)
    from state_correct have "preallocated h"
      by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
    from Checkcast stk_loc_succs sees_M reachable applicable
    have "stkLength P C M (Suc pc) = stkLength P C M pc"
      and "locLength P C M (Suc pc) = locLength P C M pc"
      by auto
    with Checkcast state_correct ve sees_M
      trg_state_correct applicable a_pred pred_s ‹preallocated h
    show ?thesis
      apply (clarsimp simp del: exec.simps)
      apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       defer
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
       apply (clarsimp simp del: exec.simps find_handler_for.simps)
       apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
       apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
         apply fastforce
        apply (fastforce simp: split_beta)
       apply clarsimp
      by (auto simp: split_beta bv_conform_def
           simp del: find_handler_for.simps)
  next
    case Throw
    from state_correct have "preallocated h"
      by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
    from Throw applicable state_correct sees_M obtain a
      where "stk(length cs, stkLength P C M pc - 1) = Null 
             stk(length cs, stkLength P C M pc - 1) = Addr a"
      by (cases "stk(length cs, stkLength P C M pc - 1)",
          auto simp: is_refT_def bv_conform_def correct_state_def conf_def)
    with Throw state_correct ve trg_state_correct a_pred applicable sees_M ‹preallocated h
    show ?thesis
      apply (clarsimp simp del: exec.simps)
      apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
      apply (clarsimp simp del: exec.simps find_handler_for.simps)
      apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
      apply (clarsimp simp: bv_conform_def simp del: exec.simps find_handler_for.simps)
      apply (rule conjI)
       apply (clarsimp simp: stkss_purge simp del: exec.simps find_handler_for.simps)
       apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
         apply fastforce
        apply (simp add: hd_stks)
       apply simp
      apply (clarsimp simp: stkss_purge simp del: exec.simps find_handler_for.simps)
      apply (simp del: find_handler_for.simps exec.simps cong: if_cong)
      apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
        apply fastforce
       apply (simp add: hd_stks)
      by simp
  qed
qed


section ‹CFG simulates Jinja's semantics›

subsection ‹Definitions›

text ‹
The following predicate defines the semantics of Jinja lifted to our
state representation. Thereby, we require the state to be byte code verifier
conform; otherwise the step in the semantics is undefined.

The predicate valid_callstack› is actually an implication of the
byte code verifier conformance. But we list it explicitly for convenience.
›

inductive sem :: "jvmprog  callstack  state  callstack  state  bool"
("_  _,_  _,_")
  where Step:
  " prog = (P,C0,Main);
  P,csBV s ;
  valid_callstack prog cs;
  JVMExec.exec ((Pwf), state_to_jvm_state P cs s) = (None,h',frs');
  cs' = framestack_to_callstack frs';
  s = (h, stk, loc);
  s' = (h', update_stk stk frs', update_loc loc frs') 
   prog  cs,s  cs',s'"

abbreviation identifies :: "j_node  callstack  bool"
where "identifies n cs  (n = (_ cs,None _))"

subsection ‹Some more simplification lemmas›

lemma valid_callstack_tl:
  "valid_callstack prog ((C,M,pc)#cs)  valid_callstack prog cs"
  by (cases prog, cases cs, auto)

lemma stkss_cong [cong]:
  " P = P';
  cs = cs';
  a b.  a < length cs;
     b < stkLength P (fst(cs ! (length cs - Suc a)))
                     (fst(snd(cs ! (length cs - Suc a))))
                     (snd(snd(cs ! (length cs - Suc a)))) 
     stk (a, b) = stk' (a, b) 
   stkss P cs stk = stkss P' cs' stk'"
  by (auto, hypsubst_thin, induct cs',
    auto intro!: nth_equalityI simp: nth_Cons' (* nth_stks *))

lemma locss_cong [cong]:
  " P = P';
  cs = cs';
  a b.  a < length cs;
     b < locLength P (fst(cs ! (length cs - Suc a)))
                     (fst(snd(cs ! (length cs - Suc a))))
                     (snd(snd(cs ! (length cs - Suc a)))) 
     loc (a, b) = loc' (a, b) 
   locss P cs loc = locss P' cs' loc'"
  by (auto, hypsubst_thin, induct cs',
    auto intro!: nth_equalityI simp: nth_Cons' (* nth_locs *))

lemma hd_tl_equalityI:
  " length xs = length ys; hd xs = hd ys; tl xs = tl ys   xs = ys"
apply (induct xs arbitrary: ys)
 apply simp
by (case_tac ys, auto)

lemma stkLength_is_length_stk:
  "Pwf,PΦ  (None, h, (stk, loc, C, M, pc) # frs')   stkLength P C M pc = length stk"
  by (auto dest!: list_all2_lengthD simp: correct_state_def)

lemma locLength_is_length_loc:
  "Pwf,PΦ  (None, h, (stk, loc, C, M, pc) # frs')   locLength P C M pc = length loc"
  by (auto dest!: list_all2_lengthD simp: correct_state_def)

lemma correct_state_frs_tlD:
  "(Pwf),(PΦ)  (None, h, a # frs')   (Pwf),(PΦ)  (None, h, frs') "
  by (cases frs', (fastforce simp: correct_state_def)+)

lemma update_stk_Cons [simp]:
  "stkss P (framestack_to_callstack frs') (update_stk stk ((stk', loc', C', M', pc') # frs')) =
  stkss P (framestack_to_callstack frs') (update_stk stk frs')"
apply (induct frs' arbitrary: stk' loc' C' M' pc')
 apply clarsimp
 apply (simp only: f2c_Nil)
 apply clarsimp
apply clarsimp
apply (simp only: f2c_Cons)
apply clarsimp
apply (rule stkss_cong)
  by (fastforce simp: nth_Cons')+

lemma update_loc_Cons [simp]:
  "locss P (framestack_to_callstack frs') (update_loc loc ((stk', loc', C', M', pc') # frs')) =
  locss P (framestack_to_callstack frs') (update_loc loc frs')"
apply (induct frs' arbitrary: stk' loc' C' M' pc')
 apply clarsimp
 apply (simp only: f2c_Nil)
 apply clarsimp
apply clarsimp
apply (simp only: f2c_Cons)
apply clarsimp
apply (rule locss_cong)
  by (fastforce simp: nth_Cons')+

lemma s2j_id:
  "(Pwf),(PΦ)  (None,h',frs') 
   state_to_jvm_state P (framestack_to_callstack frs')
       (h, update_stk stk frs', update_loc loc frs') = (None, h, frs')"
apply (induct frs')
 apply simp
apply simp
apply (rule hd_tl_equalityI)
  apply simp
 apply simp
 apply clarsimp
 apply (simp only: f2c_Cons fst_conv snd_conv)
 apply clarsimp
 apply (rule conjI)
  apply (rule nth_equalityI)
   apply (simp add: stkLength_is_length_stk)
  apply (clarsimp simp: (* nth_stks *) stkLength_is_length_stk)
  apply (case_tac a, simp_all)
 apply (rule nth_equalityI)
  apply (simp add: locLength_is_length_loc)
 apply (clarsimp simp: (* nth_locs *) locLength_is_length_loc)
apply (drule correct_state_frs_tlD)
apply simp
apply clarsimp
apply (simp only: f2c_Cons fst_conv snd_conv)
by clarsimp

lemma find_handler_last_cs_eqD:
  " find_handler Pwf a h frs = (None, h', frs');
  last frs = (stk,loc,C,M,pc);
  last frs' = (stk',loc',C',M',pc') 
   C = C'  M = M'"
  by (induct frs, auto split: if_split_asm)


lemma exec_last_frs_eq_class:
  " JVMExec.exec (Pwf, None, h, frs) = (None, h', frs');
  last frs = (stk, loc, C, M, pc);
  last frs' = (stk', loc', C', M', pc');
  frs  [];
  frs'  [] 
   C = C'"
apply (cases frs, auto split: if_split_asm)
 apply (cases "instrs_of Pwf C M ! pc", auto simp: split_beta)
 apply (case_tac "instrs_of Pwf ab ac ! b", auto simp: split_beta)
 apply (case_tac list, auto)
 apply (case_tac lista, auto)
apply (drule find_handler_last_cs_eqD)
  apply fastforce
 apply fastforce
by simp

lemma exec_last_frs_eq_method:
  " JVMExec.exec (Pwf, None, h, frs) = (None, h', frs');
  last frs = (stk, loc, C, M, pc);
  last frs' = (stk', loc', C', M', pc');
  frs  [];
  frs'  [] 
   M = M'"
apply (cases frs, auto split: if_split_asm)
 apply (cases "instrs_of Pwf C M ! pc", auto simp: split_beta)
 apply (case_tac "instrs_of Pwf ab ac ! b", auto simp: split_beta)
 apply (case_tac list, auto)
 apply (case_tac lista, auto)
apply (drule find_handler_last_cs_eqD)
  apply fastforce
 apply fastforce
by simp

lemma valid_callstack_append_last_class:
  "valid_callstack (P,C0,Main) (cs@[(C,M,pc)])  C = C0"
  by (induct cs, auto dest: valid_callstack_tl)

lemma valid_callstack_append_last_method:
  "valid_callstack (P,C0,Main) (cs@[(C,M,pc)])  M = Main"
  by (induct cs, auto dest: valid_callstack_tl)
 
lemma zip_stkss_locss_append_single [simp]:
  "zip (stkss P (cs @ [(C, M, pc)]) stk)
    (zip (locss P (cs @ [(C, M, pc)]) loc) (cs @ [(C, M, pc)]))
  = (zip (stkss P (cs @ [(C, M, pc)]) stk) (zip (locss P (cs @ [(C, M, pc)]) loc) cs))
  @ [(stks (stkLength P C M pc) (λa. stk (0, a)),
      locs (locLength P C M pc) (λa. loc (0, a)), C, M, pc)]"
  by (induct cs, auto)

subsection ‹Interpretation of the CFG_semantics_wf› locale›

interpretation JVM_semantics_CFG_wf:
  CFG_semantics_wf "sourcenode" "targetnode" "kind" "valid_edge prog" "(_Entry_)"
   "sem prog" "identifies"
  for prog
proof(unfold_locales)
  fix n c s c' s'
  assume sem_step:"prog  c,s  c',s'"
    and "identifies n c"
  obtain P C0 M0
    where prog [simp]:"prog = (P,C0,M0)"
    by (cases prog,fastforce)
  obtain h stk loc
    where s [simp]: "s = (h,stk,loc)"
    by (cases s, fastforce)
  obtain h' stk' loc'
    where s' [simp]: "s' = (h',stk',loc')"
    by (cases s', fastforce)
  from sem_step s s' prog obtain C M pc cs C' M' pc' cs'
    where c [simp]: "c = (C,M,pc)#cs"
    by (cases c, auto elim: sem.cases simp: bv_conform_def)
  with sem_step prog obtain ST LT
    where wt [simp]: " (PΦ) C M ! pc = (ST,LT)"
    by (auto elim!: sem.cases, cases cs, fastforce+)
  note P_wf = wf_jvmprog_is_wf [of P]
  from sem_step prog obtain frs'
    where jvm_exec: "JVMExec.exec ((Pwf), state_to_jvm_state P c s) = (None,h',frs')"
    by (auto elim!: sem.cases)
  with sem_step prog s s'
  have loc': "loc' = update_loc loc frs'"
    and stk': "stk' = update_stk stk frs'"
    by (auto elim!: sem.cases)
  from sem_step s prog
  have state_wf: "P,cBV (h,stk,loc) "
    by (auto elim!: sem.cases)
  hence state_correct: "(Pwf),(PΦ)  state_to_jvm_state P c (h,stk,loc) "
    by (simp add: bv_conform_def)
  with P_wf jvm_exec s 
  have trg_state_correct: "(Pwf),(PΦ)  (None,h',frs') "
    by -(rule BV_correct_1, (fastforce simp: exec_1_iff)+)
  from sem_step c s prog have prealloc: "preallocated h"
    by (auto elim: sem.cases
             simp: bv_conform_def correct_state_def hconf_def)
  from state_correct obtain Ts T mxs mxl "is" xt
    where sees_M: "(Pwf)  C sees M:TsT = (mxs,mxl,is,xt) in C"
    by (clarsimp simp: bv_conform_def correct_state_def)
  with state_correct
  have "pc < length is"
    by (auto dest: sees_method_fun
             simp: bv_conform_def correct_state_def)
  with P_wf sees_M have
    applicable: "appi(is ! pc, (Pwf), pc, mxs, T, ST, LT)"
    by (fastforce dest!: sees_wf_mdecl
                  simp: wf_jvm_prog_phi_def wf_mdecl_def wt_method_def)
  from sem_step
  have v_cs: "valid_callstack prog c"
    by (auto elim: sem.cases)
  then obtain pcL where last_c: "last c = (C0,M0,pcL)"
    apply clarsimp
    apply (induct cs arbitrary: C M pc, simp)
    by fastforce
  from sees_M P_wf pc < length is
  have wt_instrs: "Pwf,T,mxs,length is,xt  is ! pc,pc :: (PΦ) C M"
    by -(drule wt_jvm_prog_impl_wt_instr, fastforce+)
  with applicable
  have effect: "succ  set (succs (is ! pc) (ST,LT) pc).
    (Pwf)  effi(is ! pc, (Pwf), ST, LT) ≤' (PΦ) C M ! succ  succ < length is"
    apply clarsimp
    apply (erule_tac x="(succ, effi(is ! pc, (Pwf), ST, LT) )" in ballE)
     by (erule_tac x="(succ, effi(is ! pc, (Pwf), ST, LT) )" in ballE, clarsimp+)
   with P_wf sees_M last_c v_cs
   have v_cs_succ:
     "succ  set (succs (is ! pc) (ST,LT) pc). valid_callstack (P,C0,M0) ((C,M,succ)#cs)"
     by -(rule ballI,
       erule_tac x="succ" in ballE,
       auto,
       induct cs,
       fastforce+)
   from trg_state_correct v_cs jvm_exec
   have v_cs_f2c_frs':
     "valid_callstack (P,C0,M0) (framestack_to_callstack frs')"
     apply (cases frs' rule: rev_cases, simp)
     apply (rule_tac s="(h', update_stk stk frs', update_loc loc frs')"
       in correct_state_imp_valid_callstack)
       apply (simp only: bv_conform_def s2j_id)
      apply (auto dest!: f2c_emptyD simp del: exec.simps)
      apply (cases cs rule: rev_cases)
       apply (clarsimp simp del: exec.simps)
       apply (drule exec_last_frs_eq_class, fastforce+)
      apply (clarsimp simp del: exec.simps)
      apply (simp only: append_Cons [symmetric])
      apply (frule valid_callstack_append_last_class)
      apply (frule valid_callstack_append_last_method)
      apply (clarsimp simp del: exec.simps)
      apply (drule exec_last_frs_eq_class, fastforce+)
     apply (cases cs rule: rev_cases)
      apply (clarsimp simp del: exec.simps)
      apply (drule exec_last_frs_eq_method, fastforce+)
     apply (clarsimp simp del: exec.simps)
     apply (simp only: append_Cons [symmetric])
     apply (frule valid_callstack_append_last_method)
     apply (clarsimp simp del: exec.simps)
     by (drule exec_last_frs_eq_method, fastforce+)
  show "n' as.
             CFG.path sourcenode targetnode (valid_edge prog) n as n' 
             transfers (CFG.kinds kind as) s = s' 
             preds (CFG.kinds kind as) s  identifies n' c'"
  proof
    show "as. CFG.path sourcenode targetnode (valid_edge prog) n as (_ c',None _) 
      transfers (CFG.kinds kind as) s = s' 
      preds (CFG.kinds kind as) s 
      identifies (_ c',None _) c'"
    proof (cases "(instrs_of (Pwf) C M)!pc")
      case (Load nat)
      with sem_step s s' c prog 
      have c': "c' = (C,M,pc+1)#cs"
        by (auto elim!: sem.cases)
      from applicable sees_M Load
      have "nat < length LT"
        by simp
      from sees_M Load have "Suc pc  set (succs (is ! pc) (ST,LT) pc)"
        by simp
      with prog sem_step Load v_cs_succ
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
        (_ (C,M,Suc pc)#cs,None _))"
        (is "valid_edge prog ?e1")
        by (auto elim!: sem.cases intro: JCFG_Straight_NoExc)
      with ‹identifies n c c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from Load jvm_exec loc' stk' c c' s s' prog wt nat < length LT
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: JVM_CFG_Interpret.kinds_def
                         nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons' nth_tl
                         not_less_eq_eq Suc_le_eq)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case (Store nat)
      with sem_step s s' c prog
      have c': "c' = (C,M,pc+1)#cs"
        by (auto elim!: sem.cases)
      from applicable Store sees_M
      have "length ST > 0  nat < length LT"
        by clarsimp
      then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
      from sees_M Store have "Suc pc  set (succs (is ! pc) (ST, LT) pc)"
        by simp
      with prog sem_step Store v_cs_succ
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
        (_ (C,M,Suc pc)#cs,None _))"
        (is "valid_edge prog ?e1")
        by (fastforce elim: sem.cases intro: JCFG_Straight_NoExc)
      with ‹identifies n c c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from Store jvm_exec stk' loc' c c' s s' prog wt
        ‹length ST > 0  nat < length LT
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: JVM_CFG_Interpret.kinds_def
                         nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons' nth_tl
                         not_less_eq_eq hd_stks)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case (Push val)
      with sem_step s s' c prog 
      have c': "c' = (C,M,pc+1)#cs"
        by (auto elim!: sem.cases)
      from sees_M Push have "Suc pc  set (succs (is ! pc) (ST, LT) pc)"
        by simp
      with prog sem_step Push v_cs_succ
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
        (_ (C,M,Suc pc)#cs,None _))"
        (is "valid_edge prog ?e1")
        by (fastforce elim: sem.cases intro: JCFG_Straight_NoExc)
      with ‹identifies n c c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from Push jvm_exec stk' loc' c c' s s' prog wt
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: JVM_CFG_Interpret.kinds_def
                         nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons' nth_tl
                         not_less_eq_eq)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case (New Cl)
      show ?thesis
      proof (cases "new_Addr h")
        case None
        with New sem_step s s' c prog prealloc
        have c': "c' = find_handler_for P OutOfMemory c"
          by (fastforce elim!: sem.cases 
                        dest: find_handler_find_handler_forD)
        with jvm_exec New None prealloc
        have f2c_frs'_c': "framestack_to_callstack frs' = c'"
          by (auto dest!: find_handler_find_handler_forD)
        with New c' v_cs v_cs_f2c_frs'
        have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). new_Addr h = None),
          (_ (C,M,pc)#cs,(c',True) _))"
          (is "valid_edge prog ?e1")
          apply auto
               apply (rule JCFG_New_Exc_Pred, fastforce+)
              apply (rule_tac x="(λ(h, stk, loc). new_Addr h = None)" in exI)
              apply (rule JCFG_New_Exc_Pred, fastforce+)
             apply (cases "find_handler_for P OutOfMemory cs")
              apply (rule exI)
              apply clarsimp
              apply (rule JCFG_New_Exc_Exit, fastforce+)
             apply clarsimp
             apply (rule_tac x="λ(h, stk, loc).
               (h, stk((length list, stkLength P a aa b - Suc 0) :=
                        Addr (addr_of_sys_xcpt OutOfMemory)),
               loc)" in exI)
             apply (rule JCFG_New_Exc_Update, fastforce+)
            apply (rule JCFG_New_Exc_Pred, fastforce+)
           apply (rule exI)
           apply (rule JCFG_New_Exc_Pred, fastforce+)
          apply (rule exI)
          by (rule JCFG_New_Exc_Update, fastforce+)
        show ?thesis
        proof (cases c')
          case Nil
          with prog sem_step New c
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (fastforce elim: sem.cases intro: JCFG_New_Exc_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
            by -(simp,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
          moreover from Nil None New sem_step c c' s s' prog
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto elim!: sem.cases simp: JVM_CFG_Interpret.kinds_def)
          moreover from None s have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis using Nil by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
          from jvm_exec c s None New
          have "update_loc loc frs' = loc"
            by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc], simp)
          with loc' have "loc' = loc"
            by simp
          from c Cons s s' sem_step jvm_exec prog       
          have "(C',M',pc')#cs' = framestack_to_callstack frs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where frs': "frs' = (stk'',loc'',C',M',pc')#frs''"
            and cs': "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt OutOfMemory))"
            using c s c' None Cons prog New trg_state_correct wt jvm_exec prealloc stk'
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: hd_stks split_beta framestack_to_callstack_def
                          correct_state_def)
          with stk' have stk':
            "stk' = 
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt OutOfMemory))"
            by simp
          from New Cons v_cs_f2c_frs' v_cs f2c_frs'_c'
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
              (h,
               stk((length cs',(stkLength P C' M' pc') - 1) :=
                 Addr (addr_of_sys_xcpt OutOfMemory)),
               loc)
             ),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            apply auto
              apply (rule JCFG_New_Exc_Update)
                 apply fastforce
                apply fastforce
               using Cons c' apply simp
              apply simp
             using v_pred_edge c' Cons apply clarsimp
            using v_pred_edge c' Cons apply clarsimp
            done
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from New c c' s s' loc' stk' loc' = loc prog jvm_exec None
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest: find_handler_heap_eqD
                     simp: JVM_CFG_Interpret.kinds_def)
          moreover from None s
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      next
        case (Some obj)
        with New sem_step s s' c prog prealloc
        have c': "c' = (C,M,Suc pc)#cs"
          by (auto elim!: sem.cases)
        with New jvm_exec Some
        have f2c_frs'_c': "framestack_to_callstack frs' = c'"
          by auto
        with New c' v_cs v_cs_f2c_frs'
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). new_Addr h  None),
          (_ (C,M,pc)#cs,(c',False) _))"
          (is "valid_edge prog ?e1")
          apply auto
            apply (fastforce intro!: JCFG_New_Normal_Pred)
           apply (rule exI)
           apply (fastforce intro!: JCFG_New_Normal_Pred)
          apply (rule exI)
          by (fastforce intro!: JCFG_New_Normal_Update)
        from New sees_M have "Suc pc  set (succs (is ! pc) (ST, LT) pc)"
          by simp
        with prog New c' sem_step prog v_cs_succ
        have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',False) _),
          (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
          (_ (C,M,Suc pc)#cs,None _))"
          (is "valid_edge prog ?e2")
          by (auto elim!: sem.cases intro: JCFG_New_Normal_Update JCFG_New_Normal_Pred)
        with v_pred_edge ‹identifies n c c c'
        have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from New jvm_exec loc' stk' c c' s s' prog Some
        have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
          by (auto intro!: ext
                     simp: JVM_CFG_Interpret.kinds_def
                           nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons'
                           not_less_eq_eq hd_stks)
        moreover from Some s
        have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case (Getfield Fd Cl)
      with applicable sees_M
      have "length ST > 0"
        by clarsimp
      then obtain ST1 STr where ST [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases "stk(length cs, stkLength P C M pc - 1) = Null")
        case True
        with Getfield sem_step s s' c prog prealloc wt
        have c': "c' = find_handler_for P NullPointer c"
          by (cases "the (h (the_Addr Null))",
              auto elim!: sem.cases 
                   dest!: find_handler_find_handler_forD
                    simp: hd_stks)
        with Getfield True jvm_exec prealloc
        have "framestack_to_callstack frs' = c'"
          by (auto simp: split_beta dest!: find_handler_find_handler_forD)
        with Getfield prog c' v_cs v_cs_f2c_frs'
        have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Null),
          (_ (C,M,pc)#cs,(c',True) _))"
          (is "valid_edge prog ?e1")
          apply (auto simp del: find_handler_for.simps)
            apply (fastforce intro!: JCFG_Getfield_Exc_Pred)
           apply (fastforce intro!: JCFG_Getfield_Exc_Pred)
          apply auto
           apply (cases "find_handler_for P NullPointer cs")
            apply (fastforce intro!: JCFG_Getfield_Exc_Exit)
           apply (fastforce intro!: JCFG_Getfield_Exc_Update)
          apply (fastforce intro!: JCFG_Getfield_Exc_Update)
          done
        show ?thesis
        proof (cases c')
          case Nil
          with Getfield c prog c' v_pred_edge
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (fastforce intro: JCFG_Getfield_Exc_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
            by -(simp,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
          moreover from Nil True Getfield sem_step c c' s s' prog wt ‹length ST > 0
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto elim!: sem.cases
                      simp: hd_stks split_beta JVM_CFG_Interpret.kinds_def)
          moreover from True s
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis using Nil by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
          from jvm_exec c s True Getfield wt ST
          have "update_loc loc frs' = loc"
            by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
                 auto simp: split_beta hd_stks)
          with loc' have "loc' = loc"
            by simp
          from c Cons s s' sem_step jvm_exec prog
          have cs'_f2c_frs': "(C',M',pc')#cs' = framestack_to_callstack frs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
            and "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
            using c s c' True Cons prog Getfield trg_state_correct wt ST jvm_exec prealloc stk'
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: hd_stks split_beta framestack_to_callstack_def
                          correct_state_def)
          with stk' have stk':
            "stk' = 
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
            by simp
          from prog Cons Getfield c' v_cs v_cs_f2c_frs' jvm_exec
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
              (h,
               stk((length cs',(stkLength P C' M' pc') - 1) :=
                 Addr (addr_of_sys_xcpt NullPointer)),
               loc)
             ),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            apply (auto simp del: exec.simps find_handler_for.simps)
                apply (rule JCFG_Getfield_Exc_Update, fastforce+)
               apply (simp only: cs'_f2c_frs')
              apply (fastforce intro!: JCFG_Getfield_Exc_Pred)
             apply (fastforce intro!: JCFG_Getfield_Exc_Update)
            by (simp only: cs'_f2c_frs')
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from Getfield c c' s s' loc' stk' prog True jvm_exec
            loc' = loc wt ST
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest: find_handler_heap_eqD
                     simp: JVM_CFG_Interpret.kinds_def split_beta hd_stks)
          moreover from True s
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      next
        case False
        with Getfield sem_step s s' c prog prealloc wt ‹length ST > 0
        have c': "c' = (C,M,Suc pc)#cs"
          by (auto elim!: sem.cases 
                    simp: split_beta hd_stks)
        with False Getfield jvm_exec prealloc
        have "framestack_to_callstack frs' = c'"
          by (auto dest!: find_handler_find_handler_forD simp: split_beta)
        with Getfield c' v_cs v_cs_f2c_frs'
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1)  Null),
          (_ (C,M,pc)#cs,(c',False) _))"
          (is "valid_edge prog ?e1")
          apply auto
            apply (fastforce intro: JCFG_Getfield_Normal_Pred)
           apply (fastforce intro: JCFG_Getfield_Normal_Pred)
          by (fastforce intro: JCFG_Getfield_Normal_Update)
        with prog c' Getfield v_cs_succ sees_M
        have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',False) _),
          (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
          (_ (C,M,Suc pc)#cs,None _))"
          (is "valid_edge prog ?e2")
          by (fastforce intro: JCFG_Getfield_Normal_Update)
        with v_pred_edge ‹identifies n c c c'
        have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from Getfield jvm_exec stk' loc' c c' s s' prog False wt ST
        have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
          by (auto intro!: ext
                     simp: nth_stkss nth_locss nth_tl nth_Cons' hd_stks
                           not_less_eq_eq split_beta JVM_CFG_Interpret.kinds_def)
        moreover from False s
        have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case (Putfield Fd Cl)
      with applicable sees_M
      have "length ST > 1"
        by clarsimp
      then obtain ST1 STr' where "ST = ST1#STr'"
        by (cases ST, fastforce+)
      with ‹length ST > 1 obtain ST2 STr
        where ST: "ST = ST1#ST2#STr"
        by (cases STr', fastforce+)
      show ?thesis
      proof (cases "stk(length cs, stkLength P C M pc - 2) = Null")
        case True
        with Putfield sem_step s s' c prog prealloc wt ‹length ST > 1
        have c': "c' = find_handler_for P NullPointer c"
          by (auto elim!: sem.cases 
                   dest!: find_handler_find_handler_forD
                    simp: hd_tl_stks split_beta)
        with Putfield jvm_exec True prealloc ‹length ST > 1 wt
        have "framestack_to_callstack frs' = c'"
          by (auto dest!: find_handler_find_handler_forD simp: split_beta hd_tl_stks)
        with Putfield c' v_cs v_cs_f2c_frs'
        have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2) = Null),
          (_ (C,M,pc)#cs,(c',True) _))"
          (is "valid_edge prog ?e1")
          apply (auto simp del: find_handler_for.simps)
            apply (fastforce intro: JCFG_Putfield_Exc_Pred)
           apply (fastforce intro: JCFG_Putfield_Exc_Pred)
          apply (cases "find_handler_for P NullPointer ((C, M, pc)#cs)")
           apply (fastforce intro: JCFG_Putfield_Exc_Exit)
          by (fastforce intro: JCFG_Putfield_Exc_Update)
        show ?thesis
        proof (cases c')
          case Nil
          with Putfield c prog c' v_pred_edge
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (fastforce intro: JCFG_Putfield_Exc_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
            by -(simp,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
          moreover from Nil True Putfield sem_step c c' s s' prog wt ST
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto elim!: sem.cases
                      simp: split_beta JVM_CFG_Interpret.kinds_def)
          moreover from True s
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis using Nil by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
          from jvm_exec c s True Putfield ST wt
          have "update_loc loc frs' = loc"
            by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
                 auto simp: split_beta hd_tl_stks if_split_eq1)
          with sem_step s s' c prog jvm_exec
          have loc':"loc' = loc"
            by (clarsimp elim!: sem.cases)
          from c Cons s s' sem_step jvm_exec prog       
          have "stk' = update_stk stk frs'"
            and cs'_f2c_frs': "(C',M',pc')#cs' = framestack_to_callstack frs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
            and "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have stk':
            "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
            using c s Cons True prog Putfield ST wt trg_state_correct jvm_exec
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: hd_stks hd_tl_stks split_beta framestack_to_callstack_def
                          correct_state_def)
          from Cons Putfield c prog c' v_pred_edge v_cs_f2c_frs' jvm_exec
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
              (h, stk((length cs',(stkLength P C' M' pc') - 1) :=
                    Addr (addr_of_sys_xcpt NullPointer)), loc) ),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            by (auto intro!: JCFG_Putfield_Exc_Update)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from True Putfield c c' s s' loc' stk' stk' = update_stk stk frs'
                        jvm_exec wt ST
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest: find_handler_heap_eqD
                     simp: JVM_CFG_Interpret.kinds_def hd_tl_stks split_beta)
          moreover from True s
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      next
        case False
        with Putfield sem_step s s' c prog prealloc wt ‹length ST > 1
        have c': "c' = (C,M,Suc pc)#cs"
          by (auto elim!: sem.cases 
                    simp: hd_tl_stks split_beta)
        with Putfield False jvm_exec ‹length ST > 1 wt
        have "framestack_to_callstack frs' = c'"
          by (auto simp: split_beta hd_tl_stks)
        with Putfield c' v_cs v_cs_f2c_frs'
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2)  Null),
          (_ (C,M,pc)#cs,(c',False) _))"
          (is "valid_edge prog ?e1")
          apply auto
            apply (fastforce intro: JCFG_Putfield_Normal_Pred)
           apply (fastforce intro: JCFG_Putfield_Normal_Pred)
          by (fastforce intro: JCFG_Putfield_Normal_Update)
        with prog Putfield c' v_cs_succ sees_M
        have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',False) _),
          (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
          (_ (C,M,Suc pc)#cs,None _))"
          (is "valid_edge prog ?e2")
          by (fastforce intro: JCFG_Putfield_Normal_Update)
        with v_pred_edge ‹identifies n c c c'
        have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from Putfield jvm_exec stk' loc' c c' s s' prog False wt ST
        have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
          by (auto intro!: ext
                     simp: JVM_CFG_Interpret.kinds_def split_beta
                           (* nth_stks *) nth_stkss (* nth_locs *) nth_locss nth_Cons'
                           not_less_eq_eq)
        moreover from False s
        have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case (Checkcast Cl)
      with applicable sees_M
      have "length ST > 0"
        by clarsimp
      then obtain ST1 STr where ST: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases "¬ cast_ok (Pwf) Cl h (stk(length cs,length ST - Suc 0))")
        case True
        with Checkcast sem_step s s' c prog prealloc wt ‹length ST > 0
        have c': "c' = find_handler_for P ClassCast c"
          by (auto elim!: sem.cases 
                   dest!: find_handler_find_handler_forD
                    simp: hd_stks split_beta)
        with jvm_exec Checkcast True prealloc ‹length ST > 0 wt
        have "framestack_to_callstack frs' = c'"
          by (auto dest!: find_handler_find_handler_forD simp: hd_stks)
        with Checkcast c' v_cs v_cs_f2c_frs'
        have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). ¬ cast_ok (Pwf) Cl h (stk(length cs, stkLength P C M pc - Suc 0))),
          (_ (C,M,pc)#cs,(c',True) _))"
          (is "valid_edge prog ?e1")
          apply (auto simp del: find_handler_for.simps)
            apply (fastforce intro: JCFG_Checkcast_Exc_Pred)
           apply (fastforce intro: JCFG_Checkcast_Exc_Pred)
          apply (cases "find_handler_for P ClassCast ((C,M,pc)#cs)")
           apply (fastforce intro: JCFG_Checkcast_Exc_Exit)
          by (fastforce intro: JCFG_Checkcast_Exc_Update)
        show ?thesis
        proof (cases c')
          case Nil
          with Checkcast c prog c' v_pred_edge
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (fastforce intro: JCFG_Checkcast_Exc_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
            by -(simp,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
          moreover from Nil True Checkcast sem_step c c' s s' prog wt ‹length ST > 0
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto elim!: sem.cases
                      simp: hd_stks split_beta JVM_CFG_Interpret.kinds_def)
          moreover from True s wt
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis using Nil by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
          from jvm_exec c s True Checkcast ST wt
          have loc'': "update_loc loc frs' = loc"
            by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
                 auto simp: split_beta hd_tl_stks if_split_eq1)
          from c Cons s s' sem_step jvm_exec prog       
          have "stk' = update_stk stk frs'"
            and [simp]: "framestack_to_callstack frs' = (C', M', pc')#cs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
            and "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have stk'':
            "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt ClassCast))"
            using c s Cons True prog Checkcast ST wt trg_state_correct jvm_exec
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: hd_stks hd_tl_stks split_beta framestack_to_callstack_def
                          correct_state_def)
          from prog Checkcast Cons c c' v_pred_edge v_cs_f2c_frs'
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
              (h,
               stk((length cs',(stkLength P C' M' pc') - 1) :=
                 Addr (addr_of_sys_xcpt ClassCast)),
               loc)
             ),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            by (auto intro!: JCFG_Checkcast_Exc_Update)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from True Checkcast c s s' loc' stk' loc'' stk''
                        prog wt ST jvm_exec
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest: find_handler_heap_eqD
                        simp: JVM_CFG_Interpret.kinds_def split_beta)
          moreover from True s wt
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      next
        case False
        with Checkcast sem_step s s' c prog prealloc wt ‹length ST > 0
        have c': "c' = (C,M,Suc pc)#cs"
          by (auto elim!: sem.cases 
                    simp: hd_stks split_beta)
        with prog Checkcast sem_step c s v_cs_succ sees_M
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). cast_ok (Pwf) Cl h (stk(length cs, stkLength P C M pc - Suc 0))),
          (_ (C,M,Suc pc)#cs,None _))"
          (is "valid_edge prog ?e1")
          by (auto intro!: JCFG_Checkcast_Normal_Pred elim: sem.cases)
        with ‹identifies n c c c'
        have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from Checkcast jvm_exec stk' loc' c s s' prog False wt ST
        have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
          by (auto elim!: sem.cases
                  intro!: ext
                    simp: split_beta hd_stks JVM_CFG_Interpret.kinds_def
                          (* nth_stks *) nth_stkss (* nth_locs *) nth_locss nth_Cons'
                          not_less_eq_eq)
        moreover from False s wt
        have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case (Invoke M' n')
      with applicable sees_M
      have "length ST > n'"
        by clarsimp
      moreover obtain STn where "STn = take n' ST" by fastforce
      moreover obtain STs where "STs = ST ! n'" by fastforce
      moreover obtain STr where "STr = drop (Suc n') ST" by fastforce
      ultimately have ST:" ST = STn@STs#STr  length STn = n'"
        by (auto simp: id_take_nth_drop)
      with jvm_exec c s Invoke wt
      have "h = h'"
        by (auto dest: find_handler_heap_eqD
                 simp: split_beta (* nth_stks *) nth_Cons' if_split_eq1)
      show ?thesis
      proof (cases "stk(length cs, stkLength P C M pc - Suc n') = Null")
        case True
        with Invoke sem_step prog prealloc wt ST
        have c': "c' = find_handler_for P NullPointer c"
          apply (auto elim!: sem.cases
                      simp: (* nth_stks *) split_beta nth_Cons' ST
                      split: if_split_asm)
           by (auto dest!: find_handler_find_handler_forD)
        with jvm_exec True Invoke wt ST prealloc
        have "framestack_to_callstack frs' = c'"
          by (auto dest!: find_handler_find_handler_forD
                    simp: split_beta nth_Cons' (* nth_stks *) if_split_eq1)
        with Invoke c' v_cs v_cs_f2c_frs'
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk(length cs, stkLength P C M pc - Suc n') = Null ),
          (_ (C,M,pc)#cs,(c',True) _))"
          (is "valid_edge prog ?e1")
          apply (auto simp del: find_handler_for.simps)
            apply (fastforce intro: JCFG_Invoke_Exc_Pred)
           apply (fastforce intro: JCFG_Invoke_Exc_Pred)
          apply (cases "find_handler_for P NullPointer ((C, M, pc) # cs)")
           apply (fastforce intro: JCFG_Invoke_Exc_Exit)
          by (fastforce intro: JCFG_Invoke_Exc_Update)
        show ?thesis
        proof (cases c')
          case Nil
          with prog Invoke c c' v_pred_edge
          have v_exec_edge: "valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (fastforce intro: JCFG_Invoke_Exc_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(simp,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
          moreover from Invoke jvm_exec stk' loc' c c' s s'
            prog True wt ST prealloc Nil h = h'
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest!: find_handler_find_handler_forD
                      simp: split_beta JVM_CFG_Interpret.kinds_def
                            (* nth_stks *) nth_Cons' if_split_eq1 framestack_to_callstack_def)
          moreover from s True
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" 
            by (cases a, fastforce)
          from jvm_exec c s True Invoke ST wt
          have loc'': "update_loc loc frs' = loc"
            by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
                 auto simp: split_beta if_split_eq1 nth_Cons' (* nth_stks *))
          from c Cons s s' sem_step jvm_exec prog       
          have "stk' = update_stk stk frs'"
            and [simp]: "framestack_to_callstack frs' = (C',M',pc')#cs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
            and "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have stk'':
            "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
            using c s Cons True prog Invoke ST wt trg_state_correct jvm_exec
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: (* nth_stks *) nth_Cons' split_beta correct_state_def if_split_eq1)
          from Cons Invoke c prog c' v_pred_edge v_cs_f2c_frs'
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
              (h, stk((length cs',(stkLength P C' M' pc') - 1) :=
                         Addr (addr_of_sys_xcpt NullPointer)), loc) ),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            by (auto intro!: JCFG_Invoke_Exc_Update)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from Cons True Invoke jvm_exec c c' s s' loc' stk' loc'' stk''
                        prog wt ST h = h'
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto simp: JVM_CFG_Interpret.kinds_def split_beta)
          moreover from True s
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      next
        case False
        obtain D where D:
          "D = fst (method Pwf (cname_of h (the_Addr (stk (length cs, length ST - Suc n')))) M')"
          by simp
        from c wt s state_correct
        have "(Pwf),h  stks (length ST) (λa. stk (length cs, a)) [:≤] ST"
          by (clarsimp simp: bv_conform_def correct_state_def)
        with False ST wt
        have "STs  NT"
          apply -
          apply (drule_tac p="n'" in list_all2_nthD)
           apply simp
          apply (auto simp: nth_Cons' split: if_split_asm)
          apply hypsubst_thin
          by (induct STn, auto simp: nth_Cons' split: if_split_asm)
        with applicable ST Invoke sees_M
        obtain D' where D': "STs = Class D'"
          by (clarsimp simp: nth_append)
        from Invoke c s jvm_exec False wt ST D
        obtain loc'' where frs': "frs' = ([],loc'',D,M',0)#(snd(snd(state_to_jvm_state P c s)))"
          by (auto simp: split_beta if_split_eq1 (* nth_stks *) nth_Cons' ST)
        with trg_state_correct
        obtain Ts' T' mb' where D_sees_M': "(Pwf)  D sees M':Ts'T' = mb' in D"
          by (auto simp: correct_state_def)
        from state_correct c s wt ST D'
        have stk_wt: "Pwf,h  stk (length cs, length STn + length STr) #
          stks (length STn + length STr) (λa. stk (length cs, a)) [:≤] STn @ Class D' # STr"
          by (auto simp: correct_state_def)
        have "(stk (length cs, length STn + length STr) #
          stks (length STn + length STr) (λa. stk (length cs, a))) ! length STn =
          stk (length cs, length STr) "
          by (auto simp: nth_Cons' (* nth_stks *) ST)
        with stk_wt
        have "Pwf,h  stk (length cs, length STr) :≤ Class D'"
          by (drule_tac P="conf (Pwf) h" and p="length STn" in list_all2_nthD,
            auto simp: nth_append)
        with False ST wt
        have subD': "(Pwf)  (cname_of h (the_Addr (stk (length cs, length ST - Suc n')))) * D'"
          by (cases "stk (length cs, length STr)", auto simp: conf_def)
        from trg_state_correct frs' D_sees_M' Invoke s c
        have "length Ts' = n'"
          by (auto dest: sees_method_fun simp: correct_state_def)
        with c trg_state_correct wt ST D_sees_M' D P_wf frs' subD' D'
        obtain Ts T mxs mxl "is" xt
          where stk_sees_M':
          "(Pwf)  (cname_of h (the_Addr (stk (length cs, length ST - Suc n'))))
                           sees M':TsT = (mxs,mxl,is,xt) in D"
          by (auto dest: sees_method_fun
                  dest!: sees_method_mono
                   simp: correct_state_def split_beta nth_append wf_jvm_prog_phi_def
               simp del: ST)
        with c s False jvm_exec Invoke frs' wt ‹length ST > n'
        have loc'':
          "loc'' = stk (length cs, length ST - Suc n') #
                   rev (take n' (stks (length ST) (λa. stk(length cs, a)))) @
                   replicate mxl arbitrary"
          by (auto simp: split_beta (* nth_stks *) if_split_eq1 simp del: ST)
        with trg_state_correct frs' Invoke wt ‹length ST > n'
        have locLength_trg:
          "locLength P D M' 0 = n' + Suc mxl"
          by (auto dest: list_all2_lengthD simp: correct_state_def)
        from stk' frs' c s
        have "stk' = stk"
          by (auto intro!: ext
                     simp: (* nth_stks *) nth_stkss nth_Cons' not_less_eq_eq Suc_le_eq
                 simp del: ST)
        from loc' frs' c s loc'' wt ST
        have upd_loc': "loc' = (λ(a, b).
           if a = Suc (length cs)  Suc (n' + mxl)  b then loc (a, b)
           else if b  n' then stk (length cs, Suc (n' + length STr) - (Suc n' - b))
                else arbitrary)"
          by (auto intro!: ext
                     simp: (* nth_locs *) nth_locss nth_Cons' nth_append rev_nth (* nth_stks *) 
                           not_less_eq_eq Suc_le_eq less_Suc_eq add.commute
                           min.absorb1 min.absorb2 max.absorb1 max.absorb2)
        from frs' jvm_exec sem_step prog
        have c': "c' = (D,M',0)#c"
          by (auto elim!: sem.cases)
        from frs'
        have "framestack_to_callstack frs' = (D, M', 0) # (C, M, pc) # cs"
          by simp
        with Invoke c' v_cs v_cs_f2c_frs'
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk',loc).
            stk'(length cs, stkLength P C M pc - Suc n')  Null 
            fst(method (Pwf)
                 (cname_of h (the_Addr(stk'(length cs, stkLength P C M pc - Suc n')))) M'
            ) = D
          ),
          (_ (C,M,pc)#cs,(c',False) _))"
          (is "valid_edge prog ?e1")
          apply auto
            apply (fastforce intro: JCFG_Invoke_Normal_Pred)
           apply (fastforce intro: JCFG_Invoke_Normal_Pred)
          apply (rule exI)
          by (fastforce intro: JCFG_Invoke_Normal_Update)
        with Invoke v_cs_f2c_frs' c' v_cs
        have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',False) _),
          (λs.
            exec_instr (instrs_of (Pwf) C M ! pc) P s
              (length cs) (stkLength P C M pc) 0 (locLength P D M' 0)
          ),
          (_ (D,M',0)#c,None _))"
          (is "valid_edge prog ?e2")
          by (fastforce intro!: JCFG_Invoke_Normal_Update
                     simp del: exec.simps valid_callstack.simps)
        with v_pred_edge ‹identifies n c c c' locLength_trg
        have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from s s' h = h' stk' = stk upd_loc'
          locLength_trg stk_sees_M' Invoke c wt ST
        have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'" 
          by (simp add: JVM_CFG_Interpret.kinds_def)
        moreover from False s D wt have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case Return
      with applicable sees_M
      have "length ST > 0"
        by clarsimp
      then obtain ST1 STr where ST: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases cs)
        case Nil
        with sem_step s s' c prog Return
        have c': "c' = []  C = C0  M = M0"
          by (auto elim!: sem.cases)
        with prog sem_step Return Nil c
        have v_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          id,
          (_Exit_))"
          (is "valid_edge prog ?e1")
          by (fastforce intro: JCFG_ReturnExit elim: sem.cases)
        with ‹identifies n c c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from Return sem_step c c' s s' prog wt Nil ‹length ST > 0
        have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
          by (auto elim!: sem.cases simp: JVM_CFG_Interpret.kinds_def)
        moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      next
        case (Cons a cs')
        with c obtain D M' pc' where c: "c = (C,M,pc)#(D,M',pc')#cs'" by (cases a, fastforce)
        with prog sem_step Return
        have c': "c' = (D,M',Suc pc')#cs'"
          by (auto elim!: sem.cases)
        from c s jvm_exec Return
        have "h = h'"
          by (auto simp: split_beta)
        from c s jvm_exec loc' Return
        have "loc' = loc"
          by (auto intro!: ext
                     simp: split_beta not_less_eq_eq Suc_le_eq not_less_eq less_Suc_eq_le
                           (* nth_locs *) nth_locss hd_stks nth_Cons')
        from c s jvm_exec stk' Return ST wt trg_state_correct
        have stk_upd:
          "stk' =
          stk((length cs', stkLength P D M' (Suc pc') - 1) :=
            stk(Suc (length cs'), length ST - 1))"
          by (auto intro!: ext
                    dest!: list_all2_lengthD
                     simp: split_beta not_less_eq_eq Suc_le_eq
                           (* nth_stks *) nth_stkss hd_stks nth_Cons' correct_state_def)
        from jvm_exec Return c' c
        have "framestack_to_callstack frs' = c'"
          by auto
        with Return v_cs v_cs_f2c_frs' c' c
        have v_edge: "valid_edge prog ((_ (C,M,pc)#(D,M',pc')#cs',None _),
          (λs. exec_instr Return P s
             (Suc (length cs')) (stkLength P C M pc) (stkLength P D M' (Suc pc')) 0),
          (_ (D,M',Suc pc')#cs',None _))"
          (is "valid_edge prog ?e1")
          by (fastforce intro: JCFG_Return_Update)
        with ‹identifies n c c c' 
        have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from stk' loc' s s' h = h' loc' = loc stk_upd wt
        have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case Pop
      with sem_step s s' c prog 
      have c': "c' = (C,M,pc+1)#cs"
        by (auto elim!: sem.cases)
      from Pop sees_M applicable
      have "ST  []"
        by clarsimp
      then obtain ST1 STr where ST: "ST = ST1#STr"
        by (cases ST, fastforce+)
      with c' jvm_exec Pop
      have "framestack_to_callstack frs' = c'"
        by auto
      with Pop v_cs v_cs_f2c_frs' c'
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
        (_ (C,M,Suc pc)#cs,None _))"
        (is "valid_edge prog ?e1")
        by (fastforce intro: JCFG_Straight_NoExc)
      with ‹identifies n c c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from Pop jvm_exec s s' stk' loc' c wt ST
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons' nth_tl
                         not_less_eq_eq Suc_le_eq JVM_CFG_Interpret.kinds_def)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case IAdd
      with sem_step s s' c prog 
      have c': "c' = (C,M,pc+1)#cs"
        by (auto elim!: sem.cases)
      from IAdd applicable sees_M
      have "length ST > 1"
        by clarsimp
      then obtain ST1 STr' where "ST = ST1#STr'" by (cases ST, fastforce+)
      with ‹length ST > 1 obtain ST2 STr
        where ST: "ST = ST1#ST2#STr" by (cases STr', fastforce+)
      from c' jvm_exec IAdd
      have "framestack_to_callstack frs' = c'"
        by auto
      with IAdd c' v_cs v_cs_f2c_frs'
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
        (_ (C,M,Suc pc)#cs,None _))"
        (is "valid_edge prog ?e1")
        by (fastforce intro: JCFG_Straight_NoExc)
      with ‹identifies n c c c'
      have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from IAdd jvm_exec c s s' stk' loc' wt ST
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons' nth_tl
                         hd_stks hd_tl_stks
                         not_less_eq_eq Suc_le_eq JVM_CFG_Interpret.kinds_def)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case (IfFalse b)
      with applicable sees_M
      have "ST  []"
        by clarsimp
      then obtain ST1 STr where ST [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
      show ?thesis
      proof (cases "stk (length cs, stkLength P C M pc - 1) = Bool False  b  1")
        case True
        with sem_step s s' c prog IfFalse wt ST
        have c': "c' = (C,M,nat (int pc + b))#cs"
          by (auto elim!: sem.cases
                    simp: hd_stks)
        with jvm_exec IfFalse True
        have "framestack_to_callstack frs' = c'"
          by auto
        with c' IfFalse True v_cs v_cs_f2c_frs'
        have v_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk (length cs, stkLength P C M pc - 1) = Bool False),
          (_ (C,M,nat (int pc + b))#cs,None _))"
          (is "valid_edge prog ?e1")
          by (fastforce intro: JCFG_IfFalse_False)
        with ‹identifies n c c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from IfFalse True jvm_exec c s s' stk' loc' wt ST
        have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
          by (auto intro!: ext
                     simp: hd_stks nth_stkss nth_locss nth_Cons' nth_tl
                           JVM_CFG_Interpret.kinds_def not_less_eq_eq)
        moreover from True s
        have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      next
        case False
        have "nat (int pc + 1) = Suc pc"
          by (cases pc, auto)
        with False sem_step s s' c prog IfFalse wt ST
        have c': "c' = (C,M,Suc pc)#cs"
          by (auto elim!: sem.cases simp: hd_stks)
        with jvm_exec IfFalse False
        have "framestack_to_callstack frs' = c'"
          by auto
        with c' IfFalse False v_cs v_cs_f2c_frs'
        have v_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc). stk (length cs, stkLength P C M pc - 1)  Bool False  b = 1),
          (_ (C,M,Suc pc)#cs,None _))"
          (is "valid_edge prog ?e1")
          by (fastforce intro: JCFG_IfFalse_Next)
        with ‹identifies n c c c'
        have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
          by -(simp,
            rule JVM_CFG_Interpret.path.Cons_path,
            rule JVM_CFG_Interpret.path.empty_path,
            auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
        moreover from IfFalse False jvm_exec c s s' stk' loc' wt ST
        have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
          by (auto intro!: ext
                     simp: hd_stks nth_stkss nth_locss nth_Cons' nth_tl
                           JVM_CFG_Interpret.kinds_def not_less_eq_eq)
        moreover from False s
        have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
          by (simp add: JVM_CFG_Interpret.kinds_def)
        ultimately show ?thesis by fastforce
      qed
    next
      case (Goto i)
      with sem_step s s' c prog 
      have c': "c' = (C,M,nat (int pc + i))#cs"
        by (auto elim!: sem.cases)
      with jvm_exec Goto
      have "framestack_to_callstack frs' = c'"
        by auto
      with c' Goto v_cs v_cs_f2c_frs'
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        id,
        (_ (C,M,nat (int pc + i))#cs,None _))"
        (is "valid_edge prog ?e1")
        by (fastforce intro: JCFG_Goto_Update)
      with ‹identifies n c c c'
      have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from Goto jvm_exec c s s' stk' loc'
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons'
                         JVM_CFG_Interpret.kinds_def not_less_eq_eq)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case CmpEq
      with sem_step s s' c prog 
      have c': "c' = (C,M,Suc pc)#cs"
        by (auto elim!: sem.cases)
      from CmpEq applicable sees_M
      have "length ST > 1"
        by clarsimp
      then obtain ST1 STr' where "ST = ST1#STr'" by (cases ST, fastforce+)
      with ‹length ST > 1 obtain ST2 STr
        where ST: "ST = ST1#ST2#STr" by (cases STr', fastforce+)
      from c' CmpEq jvm_exec
      have "framestack_to_callstack frs' = c'"
        by auto
      with c' CmpEq v_cs v_cs_f2c_frs'
      have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
        (λs. exec_instr (instrs_of (Pwf) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
        (_ (C,M,Suc pc)#cs,None _))"
        (is "valid_edge prog ?e1")
        by (fastforce intro: JCFG_Straight_NoExc)
      with ‹identifies n c c c'
      have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
        by -(simp,
          rule JVM_CFG_Interpret.path.Cons_path,
          rule JVM_CFG_Interpret.path.empty_path,
          auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
      moreover from CmpEq jvm_exec c s s' stk' loc' wt ST
      have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
        by (auto intro!: ext
                   simp: nth_stkss (* nth_stks *) nth_locss (* nth_locs *) nth_Cons' nth_tl
                         hd_stks hd_tl_stks
                         not_less_eq_eq JVM_CFG_Interpret.kinds_def)
      moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
        by (simp add: JVM_CFG_Interpret.kinds_def)
      ultimately show ?thesis by fastforce
    next
      case Throw
      with sees_M applicable
      have "ST  []"
        by clarsimp
      then obtain ST1 STr where ST: "ST = ST1#STr" by (cases ST, fastforce+)
      from jvm_exec sem_step
      have f2c_frs'_eq_c': "framestack_to_callstack frs' = c'"
        by (auto elim: sem.cases)
      show ?thesis
      proof (cases "stk(length cs, stkLength P C M pc - 1) = Null")
        case True
        with sem_step Throw s s' c prog wt ST prealloc
        have c':"c' = find_handler_for P NullPointer c"
          by (fastforce elim!: sem.cases
                        dest: find_handler_find_handler_forD
                        simp: hd_stks)
        with Throw v_cs v_cs_f2c_frs' f2c_frs'_eq_c' prealloc
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc).
            (stk(length cs, stkLength P C M pc - 1) = Null 
             find_handler_for P NullPointer ((C,M,pc)#cs) = c') 
            (stk(length cs, stkLength P C M pc - 1)  Null 
             find_handler_for P (cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1))))
               ((C,M,pc)#cs) = c')
          ),
        (_ (C,M,pc)#cs,(c',True) _))"
        (is "valid_edge prog ?e1")
        apply (auto simp del: find_handler_for.simps)
          apply (fastforce intro: JCFG_Throw_Pred)
         apply (fastforce intro: JCFG_Throw_Pred)
        apply (cases "find_handler_for P NullPointer ((C, M, pc) # cs)")
         apply (fastforce intro: JCFG_Throw_Exit)
        by (fastforce intro: JCFG_Throw_Update)
        show ?thesis
        proof (cases c')
          case Nil
          with prog Throw c c' sem_step v_pred_edge
          have v_exec_edge: "valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (auto intro: JCFG_Throw_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(simp,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
          moreover from Throw jvm_exec c c' s s' stk' loc'
            True Nil wt ST trg_state_correct prealloc
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (cases frs',
                auto dest: find_handler_find_handler_forD
                     simp: JVM_CFG_Interpret.kinds_def split_beta correct_state_def)
          moreover from True s wt c' c have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc'
            where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
          with jvm_exec s loc' c True Throw wt ST
          have "loc' = loc"
            by (auto intro!: ext
                       simp: find_handler_loc_fun_eq'
                             not_less_eq_eq nth_Cons' (* nth_locs *) nth_locss)
          from c Cons s s' sem_step jvm_exec prog
          have "stk' = update_stk stk frs'"
            and "(C',M',pc')#cs' = framestack_to_callstack frs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
            and "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have stk'':
            "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
            using c s Cons True prog Throw ST wt trg_state_correct jvm_exec
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: (* nth_stks *) nth_Cons' split_beta correct_state_def if_split_eq1)
          from (C',M',pc')#cs' = framestack_to_callstack frs' Cons
          have "framestack_to_callstack frs' = c'"
            by simp
          with Cons Throw v_cs v_cs_f2c_frs' v_pred_edge
          have v_exec_edge:
            "valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
            (h,
             stk((length cs',stkLength P C' M' pc' - 1) :=
              if (stk(length cs, stkLength P C M pc - 1) = Null)
                then Addr (addr_of_sys_xcpt NullPointer)
                else (stk(length cs, stkLength P C M pc - 1))),
             loc)
            ),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            by (auto intro!: JCFG_Throw_Update)
          with v_pred_edge ‹identifies n c c c' True prog
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from Cons True Throw jvm_exec c c' s s' loc' = loc stk' stk'' wt ST
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest: find_handler_heap_eqD simp: JVM_CFG_Interpret.kinds_def)
          moreover from True s wt c c'
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      next
        case False
        with sem_step Throw s s' c prog wt ST prealloc
        have c':
          "c' = find_handler_for P
            (cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1)))) c"
          by (fastforce elim!: sem.cases
                        dest: find_handler_find_handler_forD
                        simp: hd_stks)
        with Throw v_cs v_cs_f2c_frs' f2c_frs'_eq_c'
        have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
          (λ(h,stk,loc).
            (stk(length cs, stkLength P C M pc - 1) = Null 
             find_handler_for P NullPointer ((C,M,pc)#cs) = c') 
            (stk(length cs, stkLength P C M pc - 1)  Null 
             find_handler_for P (cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1))))
               ((C,M,pc)#cs) = c')
          ),
        (_ (C,M,pc)#cs,(c',True) _))"
        (is "valid_edge prog ?e1")
        apply (auto simp del: find_handler_for.simps)
          apply (fastforce intro: JCFG_Throw_Pred)
         apply (fastforce intro: JCFG_Throw_Pred)
        apply (cases "find_handler_for P
          (cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1)))) ((C,M,pc)#cs)")
         apply (fastforce intro: JCFG_Throw_Exit)
        by (fastforce intro: JCFG_Throw_Update)
        show ?thesis
        proof (cases c')
          case Nil
          with prog Throw c c' v_pred_edge
          have v_exec_edge: "valid_edge prog ((_ (C,M,pc)#cs,([],True) _),
            id,
            (_Exit_))"
            (is "valid_edge prog ?e2")
            by (auto intro!: JCFG_Throw_Exit)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from Throw jvm_exec c c' s s' False Nil trg_state_correct wt ST
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (cases frs',
                auto dest: find_handler_find_handler_forD
                     simp: JVM_CFG_Interpret.kinds_def correct_state_def)
          moreover from False s wt c' c 
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        next
          case (Cons a cs')
          then obtain C' M' pc'
            where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
          with jvm_exec s loc' c Throw wt ST
          have "loc' = loc"
            by (auto intro!: ext
                       simp: find_handler_loc_fun_eq'
                             not_less_eq_eq nth_Cons' (* nth_locs *) nth_locss)
          from c Cons s s' sem_step jvm_exec prog
          have "stk' = update_stk stk frs'"
            and "(C',M',pc')#cs' = framestack_to_callstack frs'"
            by (auto elim!: sem.cases)
          moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
            and "cs' = framestack_to_callstack frs''" using calculation
            by (cases frs', fastforce+)
          ultimately
          have stk'':
            "update_stk stk frs' =
            stk((length cs',stkLength P C' M' pc' - Suc 0) :=
              Addr (the_Addr (stk((length cs, stkLength P C M pc - Suc 0)))))"
            using c s Cons False prog Throw ST wt trg_state_correct jvm_exec
            by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
              auto dest!: list_all2_lengthD
                    simp: (* nth_stks *) nth_Cons' split_beta correct_state_def if_split_eq1)
          from applicable False Throw ST sees_M
          have "is_refT ST1"
            by clarsimp
          with state_correct wt ST c False
          have addr_the_addr_stk_eq:
            "Addr(the_Addr(stk(length cs, length STr))) = stk(length cs, length STr)"
            by (cases "stk (length cs, length STr)",
              auto simp: correct_state_def is_refT_def conf_def)
          from (C',M',pc')#cs' = framestack_to_callstack frs' Cons
          have "framestack_to_callstack frs' = c'"
            by simp
          with Cons Throw v_cs v_cs_f2c_frs' v_pred_edge
          have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,(c',True) _),
            (λ(h,stk,loc).
            (h,
            stk((length cs',stkLength P C' M' pc' - 1) :=
              if (stk(length cs, stkLength P C M pc - 1) = Null)
                then Addr (addr_of_sys_xcpt NullPointer)
                else (stk(length cs, stkLength P C M pc - 1))),
            loc)),
            (_ c',None _))"
            (is "valid_edge prog ?e2")
            by (auto intro!: JCFG_Throw_Update)
          with v_pred_edge ‹identifies n c c c' Nil
          have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
            by -(rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.Cons_path,
              rule JVM_CFG_Interpret.path.empty_path,
              auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
          moreover from Cons False Throw jvm_exec c c' s s' loc' stk'
            addr_the_addr_stk_eq prog wt ST loc' = loc stk''
          have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
            by (auto dest: find_handler_heap_eqD
                     simp: JVM_CFG_Interpret.kinds_def)
          moreover from False s wt c c'
          have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
            by (simp add: JVM_CFG_Interpret.kinds_def)
          ultimately show ?thesis by fastforce
        qed
      qed
    qed
  qed
qed


end

Theory Slicing

theory Slicing
imports
  "Basic/Postdomination"
  "Basic/CFGExit_wf"
  "Basic/SemanticsCFG"
  "Dynamic/DynSlice"
  "StaticIntra/CDepInstantiations"
  "StaticIntra/ControlDependenceRelations"
  "While/DynamicControlDependences"
  "While/StaticControlDependences"
  "JinjaVM/JVMControlDependences" 
  "JinjaVM/SemanticsWF"
begin

end